home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 059 (1988-05-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 059 (1988-05-15)(Ossowski, Stefan)(DE)(PD).adf / Haushaltssystem / HHB V1.0.ascii < prev    next >
Text File  |  1988-04-22  |  57KB  |  2,197 lines
  1. IF FRE(-1) < 90000& THEN
  2.  LOCATE 11,20:PRINT "Es ist leider zuwenig Speicher frei !"
  3.  GOSUB Mouseclick:SYSTEM
  4. END IF
  5. ON BREAK GOSUB Ende:BREAK ON:ON ERROR GOTO Fehlerdiagnose                                                    
  6. SCREEN 1,640,200,2,2                                    
  7. WINDOW 1," Haushaltsbuch V 1.0 ============================= Geschrieben von Sauer Franz ",(0,10)-(631,186),16,1
  8. LOCATE 12,26:PRINT "Systemkonfigurierung läuft !" 
  9. MOUSE OFF : MENU OFF
  10. GOSUB Farbeinstellung
  11. GOSUB Outoffmemtext
  12. GOSUB Openlibrarys
  13. GOSUB Declarieren
  14. GOSUB Variablendim
  15. GOSUB Systemset
  16. GOSUB Systemsetload
  17. GOSUB Datalesen
  18. GOSUB Cursor
  19. CLS
  20. LOCATE 12,23:PRINT "Ich lese die Haushaltsdaten ein !"
  21. GOSUB Datenein 
  22. CLS
  23. LOCATE 12,25:PRINT "Ich lese die Kontenliste ein !" 
  24. GOSUB Konteneinlesen
  25. CLS
  26. LOCATE 12,26:PRINT "Ich erstelle die Menüleiste !" 
  27.  
  28. Menuinit:
  29.  
  30. MENU OFF
  31. FOR x%=1 TO 14:m%(1,x%)=1:m%(2,x%)=1:NEXT
  32. GOSUB Menuleiste1 : GOSUB Menuleiste2 
  33. GOSUB Konteneinlesen
  34. GOSUB Machkonten
  35. IF sortflag%=0 THEN MENU 2,8,2:MENU 2,9,1:ELSE:MENU 2,8,1:MENU 2,9,2
  36. IF detailflag%=1 THEN MENU 2,5,1:MENU 2,6,2
  37. IF gesamtflag%=1 THEN MENU 2,5,2:MENU 2,6,1
  38. ON MOUSE GOSUB Mousecheck 
  39. ON MENU GOSUB Menuabfrage 
  40. CLS
  41.  
  42. Programmstart:
  43. GOSUB Windowclose3:fakt%=0
  44. GOSUB Tabmaske
  45. GOSUB datum
  46.  
  47. Menucheck: 
  48.  
  49.  IF tagkorflag%=1 OR kontenaktiv%=1 OR fakt%=1 OR printakt%=1 OR mousep%>0 THEN 
  50.    MENU OFF
  51.   ELSE 
  52.    MENU ON
  53.  END IF
  54.  MOUSE ON  
  55.  IF FRE(-1)<23000& THEN GOSUB Outoffmem 
  56.  SLEEP
  57.  IF hlf%=1 THEN
  58.    IF INKEY$<>"" THEN tdr=1:GOSUB Mouseposition
  59.  END IF
  60. GOTO Menucheck
  61.  
  62. Menuabfrage: 
  63.  
  64.  leiste = MENU(0): punkte = MENU(1)
  65.  IF hilfeflag%=1 THEN Hilferoutine
  66.  
  67. Menuwahl: 
  68.  
  69.  MENU OFF: MOUSE OFF
  70.  ON leiste GOTO Larbeit,Lausgabe,Kontoakt,Kontoakt,Kontoakt,Kontoakt,Kontoakt
  71.  
  72. Larbeit:  
  73.  
  74.   ON punkte GOTO Tagein,Tagkor,Zeitmaske,datum,Filtertext,Wae,Datenakt,Konten,Sort,Import,Export,Sysst,Hilfe,Autor,Progende 
  75.   
  76. Lausgabe: 
  77.  
  78.  ON punkte GOTO Tabausgabe,Tabprint,Nix,Msw2,Msw2,Msw2,Msw2,Msw2,Msw2,Msw2,Nix,Selektieren,Selinv,Selloe           
  79.  
  80. datum:  
  81.  
  82.  windowtext$="Datumeingabe:":GOSUB Openwindow3
  83.  GOSUB Datumeingabe
  84.  GOSUB Windowclose3
  85. RETURN
  86.  
  87. Kontoakt:  
  88.  
  89.  IF eingmod=1 THEN kl=leiste:kp=punkte:eingmod=0:MENU ON:RETURN  
  90.  eingmod=3
  91.  GOSUB Menurefresh 
  92. RETURN
  93.  
  94. Nix:
  95. RETURN
  96.  
  97. Tagkor:
  98.  
  99.  tagkorflag%=1
  100.  GOSUB Tabausgabe
  101. RETURN
  102.  
  103. Tagkor1: 
  104.  
  105.  IF show%(calcnr%)=0 THEN RETURN
  106.  daten$=ds$(show%(calcnr%))
  107.  kl=VAL(LEFT$(daten$,1)):kp=VAL(MID$(daten$,2,1))
  108.  datumchange=1
  109.  datum$=MID$(daten$,4,8)
  110.  komentar$=MID$(daten$,24,LEN(daten$)-32)
  111.  komentar$=LEFT$(komentar$,40)
  112.  betrag$=STR$(VAL(RIGHT$(daten$,10)))
  113.  wtext3$="Tagesereignisse ändern:"
  114.  WINDOW 3,wtext3$,(80,35)-(550,150),0,1
  115.  GOTO Weiter12
  116.  
  117. Tagein: 
  118.  
  119.  MOUSE OFF
  120.  IF ml%=0 THEN
  121.  fehlertext$="Keine Eintragungen möglich. Konten fehlen !"
  122.  GOTO Fehlermeldung
  123.  END IF
  124.  IF anzahl%>=datenmenge-1 THEN
  125.  fehlertext$="Datei voll ! Bitte eine Neue beginnen.":GOTO Fehlermeldung
  126.  END IF
  127.  wtext3$="Tagesereignisse eintragen:(noch"+STR$(datenmenge-1-anzahl%)+" Eintragungen möglich !)"
  128.  WINDOW 3,wtext3$,(80,35)-(550,150),0,1
  129.  LOCATE 7,9 
  130.  PRINT "Bitte ein Konto aus Menuleiste auswählen !"
  131.  MENU ON
  132.  FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,0 
  133.  NEXT         
  134.  MENU 1,0,0:MENU 2,0,0
  135.  eingmod=1                              
  136.  WHILE eingmod=1:SLEEP:WEND
  137.  IF eingmod=3 THEN 
  138.  FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1 
  139.  NEXT         
  140.  MENU 1,0,1:MENU 2,0,1
  141.  GOTO Windowclose3
  142.  END IF
  143.  LOCATE 7,9:PRINT SPACE$(50)
  144.  LOCATE 2,25
  145. Weiter12:
  146.  GOSUB Datumeingabe
  147.  IF datum$<dzeitstart$ OR datum$>dzeitende$ THEN Weiter12
  148.  GOSUB Wochentagberechnung
  149.  CLS
  150.  LOCATE 2,11:PRINT "Eintragung für "wt$(wt%)" den "datum$
  151.  center=28-(LEN(m$(kl,kp))+40)/2
  152.  IF tagkorflag%=0 THEN
  153.    IF INSTR(kontoart$(kl,kp),"u")>0 THEN
  154.      uekl=kl:uekp=kp
  155.      LOCATE 4,center:PRINT"Überweisung vom Konto "m$(kl,kp)" ! Bitte 2.Konto wählen"
  156.      MENU ON: eingmod=1: WHILE eingmod=1:SLEEP:WEND
  157.      IF eingmod=3 THEN 
  158.        FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1
  159.        NEXT  
  160.        MENU 1,0,1:MENU 2,0,1
  161.        GOTO Windowclose3
  162.      END IF
  163.      LOCATE 4,2:PRINT SPACE$(70)
  164.      LOCATE 4,center:PRINT"Diese Eingabe wird auf das Konto "m$(kl,kp)" ueberwiesen"
  165.      laenge=36:GOTO Weiter3
  166.    END IF
  167.  END IF
  168.  laenge=40
  169.  LOCATE 4,center:PRINT"Diese Eingabe wird auf das Konto "m$(kl,kp)" verbucht" 
  170.                             
  171. Weiter3:
  172.  LOCATE 6,3:PRINT"Kommentar:":LOCATE 6,47:PRINT"Betrag"
  173.  LOCATE 8,3
  174.  msgs$="":IF tagkorflag%=1 THEN msgs$=komentar$
  175.  type%=0:GOSUB Superinput:komentar$=msgs$
  176.  IF msgs$="" THEN Weiter16
  177.  msgs$=""
  178.  IF tagkorflag%=1 THEN msgs$=betrag$
  179. 122 LOCATE 8,47:laenge=10
  180.  type%=1:GOSUB Superinput:betrag$=msgs$ 
  181.  IF betrag$="" THEN
  182.    IF funktion=9 THEN
  183.      msgs$=STR$(summe)
  184.    ELSE
  185.      msgs$=STR$(rechenwert)
  186.    END IF
  187.    GOTO 122    
  188.  END IF
  189.  IF VAL(betrag$)>=999999! OR VAL(betrag$)<=-999999& THEN 
  190.  LOCATE 8,47:PRINT SPACE$(10):GOTO 122
  191.  END IF
  192.  IF tagkorflag%=1 THEN Tagkorbest
  193.  ttextrl=12:ttextrp=18:ttextfl=12:ttextfp=35:GOSUB Bestaetigung 
  194.  mousep%=1:RETURN
  195. Mp1:
  196.  mousep%=0
  197.  IF fehler=0 THEN 
  198.    IF VAL(betrag$)=0 THEN
  199.      fehlertext$="Beträge von 0.00 "+waehrung$+" sind nicht abspeicherbar !" 
  200.      GOSUB Geisterkiller:GOTO Fehlermeldung
  201.    END IF
  202.  GOSUB Abspeichern
  203.  END IF
  204. Weiter16:
  205.  GOSUB Geisterkiller
  206.  GOTO Windowclose3
  207.  
  208. Geisterkiller:
  209.  
  210.  FOR x%=3 TO 7:IF m$(x%,1)<>"" THEN MENU x%,1,m%(x%,1)+1
  211.  NEXT    
  212.  MENU 1,0,1:MENU 2,0,1
  213. RETURN
  214.  
  215. Tagkorbest:
  216.  
  217.  request%=3
  218.  ttextrl=12:ttextrp=10:ttextwl=12:ttextwp=25:ttextfl=12:ttextfp=40
  219.  GOSUB Bestaetigung:mousep%=2:RETURN
  220. Mp2:
  221.  mousep%=0 
  222.  request%=0
  223.  IF fehler=2 THEN GOSUB Eintragen:GOTO Windowclose3
  224.  IF fehler=0 THEN 
  225.  GOSUB Eintragen:GOSUB Windowclose3:GOTO Sort
  226.  END IF
  227.  tagkorflag%=0:WINDOW OUTPUT 1:GOSUB Listen1:GOTO Windowclose3
  228.  
  229. Eintragen:
  230.  
  231.  kn$=RIGHT$(STR$(kl*10+kp),2)
  232.  ds$(show%(calcnr%))=kn$+" "+datum$+" "+wt$(wt%)+" "+komentar$+"          "+betrag$ 
  233.  WINDOW OUTPUT 1:GOSUB Listen1:WINDOW 3
  234. RETURN
  235.   
  236. Datenakt:
  237.  
  238.  MENU OFF:MOUSE OFF
  239.  WINDOW 3,"Dateien Aktualisieren:",(80,50)-(550,140),0,1
  240.  PALETTE 3,0,0,0
  241.  LOCATE 5,16:PRINT "Bitte Dateinamen eingeben !"            
  242.  LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b
  243.  PAINT (55,51),3
  244.  PALETTE 3,r(3),g(3),b(3)
  245.  IF dateiname$="" THEN dateiname$="Haushaltsdaten/"
  246.  altdn$=dateiname$
  247.  LOCATE 8,10:laenge=38:msgs$=dateiname$:GOSUB Superinput:dateiname$=msgs$
  248.  diskfehler=0
  249.  CLOSE #2
  250.  OPEN dateiname$ FOR INPUT AS #2
  251.  CLOSE #2
  252.  IF diskfehler=2 THEN
  253.  diskfehler=0
  254.  GOTO Fehlermeldung
  255.  END IF
  256.  IF diskfehler<1 THEN GOTO Dateiwechsel    ' Datei bereits vorhanden
  257.  WINDOW 3,"Dateien Aktualisieren:",(80,50)-(550,140),0,1
  258.  LOCATE 4,12:PRINT "Ich habe diese Datei nicht gefunden."
  259.  LOCATE 6,12:PRINT "Wollen Sie die Datei neu erstellen ?"
  260.  ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung 
  261.  mousep%=3:RETURN
  262. Mp3:
  263.  mousep%=0 
  264.  IF fehler=1 THEN dateiname$=altdn$:GOTO Windowclose3
  265.  
  266. Machedatei:
  267.  
  268.  
  269.  CLS
  270.  PALETTE 3,0,0,0
  271.  LINE (7,36)-(457,52),3,bf
  272.  LOCATE 6,3:COLOR 0,3:PRINT "Die Datei soll vom " 
  273.  LOCATE 6,22:COLOR 1,0:PRINT "          "
  274.  LOCATE 6,33:COLOR 0,3:PRINT" bis " 
  275.  LOCATE 6,38:COLOR 1,0:PRINT "          "
  276.  LOCATE 6,50:COLOR 0,3:PRINT"dauern."
  277.  PALETTE 3,r(3),g(3),b(3):COLOR 1,0
  278.  fehlerpos=9
  279. Weiter5:
  280.  dzeitstart$="86-01-01":dzeitende$="99-12-31"
  281.  LOCATE 6,22:laenge=8:msgs$=zeitstart$:type%=1:GOSUB Superinput
  282.  zeitstart$=msgs$
  283.  checkdat$=dzeitstart$:GOSUB Datumcheck
  284.  IF fehler=1 THEN fehler=0:GOTO Weiter5
  285. Weiter6:
  286.  LOCATE 6,38:laenge=8:msgs$=zeitende$:type%=1:GOSUB Superinput
  287.  zeitende$=msgs$
  288.  checkdat$=dzeitende$:GOSUB Datumcheck
  289.  IF fehler=1 THEN fehler=0:GOTO Weiter6
  290.  IF zeitstart$>=zeitende$ THEN Weiter5
  291.  fehler=3
  292.  ttextrl=10:ttextrp=20:ttextfl=10:ttextfp=34:GOSUB Bestaetigung
  293.  mousep%=4:RETURN
  294. Mp4:
  295.  mousep%=0 
  296.  IF fehler=1 THEN Machedatei
  297.  CLS
  298.  PALETTE 3,0,0,0
  299.  LOCATE 5,9:PRINT "Bitte den Namen der Kontenliste eingeben !"
  300.  LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b:PAINT (55,51),3
  301.  PALETTE 3,r(3),g(3),b(3)
  302.  IF Kontenliste$="" THEN Kontenliste$="Haushaltskonten/"
  303.  alkoli$=Kontenliste$
  304.  LOCATE 8,10:laenge=38:msgs$=Kontenliste$:GOSUB Superinput
  305.  Kontenliste$=msgs$
  306.  diskfehler=0
  307.  CLOSE #2
  308.  OPEN Kontenliste$ FOR INPUT AS #2
  309.  CLOSE #2
  310.  IF diskfehler=0 THEN Weiter9
  311.  fehlertext$="Kontenliste nicht vorhanden ! Bitte erstellen."
  312.  dzeitstart$=d0zeitstart$:dzeitende$=d0zeitende$
  313.  Kontenliste$=alkoli$:dateiname$=altdn$
  314. GOTO Fehlermeldung
  315.  
  316. Weiter9:
  317.  diskfehler=0:CLOSE #2
  318.  OPEN dateiname$ FOR OUTPUT AS#2
  319.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Weiter9
  320.  PRINT #2,"00 "zeitstart$" "zeitende$" "Kontenliste$
  321.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Weiter9
  322.  CLOSE #2
  323.  
  324. Dateiwechsel:
  325.  
  326.  WINDOW 3,"Dateiwechsel:",(80,50)-(550,140),0,1
  327.  CLS:LOCATE 6,17:PRINT "Lese Daten, bitte Geduld !" 
  328.  GOSUB Datenein
  329.  CLOSE #2
  330.  IF diskfehler>0 THEN Windowclose3
  331.  diskfehler=0
  332.  Kontenliste$=LEFT$(RIGHT$(ds$(0),LEN(ds$(0))-21),36)
  333.  center=19-LEN(Kontenliste$)/2
  334.  windowtext$="Dateiwechsel:":GOSUB Openwindow3
  335.  LOCATE 6,center:PRINT "Lese Kontenliste "Kontenliste$" ein !"
  336.  OPEN Kontenliste$ FOR INPUT AS #2
  337.  CLOSE #2
  338.  IF diskfehler>0 THEN
  339.    fehlertext$="Erforderliche Kontenliste nicht vorhanden !"
  340.    Kontenliste$=alkoli$
  341.    GOTO Fehlermeldung
  342.  END IF
  343.  GOSUB Konteneinlesen
  344.  GOSUB Machkonten
  345.  GOSUB Windowclose3
  346.  GOSUB Tabmaske
  347. RETURN
  348.  
  349. Abspeichern:
  350.  
  351.  diskfehler=0:CLOSE #2
  352.  OPEN dateiname$ FOR APPEND AS #2
  353.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Abspeichern 
  354.  IF diskfehler>0 THEN
  355.  fehlertext$="Kann nicht Abspeichern. Keine Datei aktuallisiert !"
  356.  GOTO Fehlermeldung
  357.  END IF
  358.  IF INSTR(kontoart$(kl,kp),"-")>0 THEN neg$="-" ELSE neg$=""
  359.  daten$=RIGHT$(STR$(kl*10+kp),2)+" "+datum$+" "+wt$(wt%)+" "+komentar$+"          "+neg$+betrag$
  360.  anzahl%=anzahl%+1
  361.  ds$(anzahl%)=RIGHT$(daten$,LEN(daten$))            
  362.  PRINT#2,daten$
  363.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Abspeichern
  364.  IF INSTR(kontoart$(uekl,uekp),"u")>0 THEN 
  365.   IF INSTR(kontoart$(uekl,uekp),"-")>0 THEN neg$="-":ELSE:neg$=""
  366.   daten$=RIGHT$(STR$(uekl*10+uekp),2)+" "+datum$+" "+wt$(wt%)+" (U) "+komentar$+"          "+neg$+betrag$
  367.   PRINT#2,daten$
  368.   uekl=0:uekp=0
  369.   anzahl%=anzahl%+1
  370.   ds$(anzahl%)=RIGHT$(daten$,LEN(daten$))
  371.  END IF
  372.  CLOSE#2
  373. RETURN
  374.  
  375. Tabausgabe:
  376.  
  377.  WINDOW 1:GOSUB Tabkopf
  378.  LINE (36,22)-(625,151),0,bf:LINE(8,36)-(27,138),0,bf  
  379.  tabaktuell=1:tabaktiv=1
  380.  LOCATE 11,23:PRINT"Bitte etwas Geduld ich suche Daten !"
  381.  IF filterflag%=1 THEN
  382.   LOCATE 13,23:PRINT"Achtung !!!!! Filterfunktion aktiv ."
  383.  END IF
  384.  IF sortflag%=0 THEN GOSUB Kontenliste 
  385.  gesamtbe=0  
  386.  z%=0 :bildzeilen=16
  387.  gesamtakt%=0
  388.  ERASE show$,show%,calc%:DIM show$(30),show%(datenmenge),calc%(datenmenge)
  389.  IF tagkorflag%=1 THEN GOSUB Suchrutine2:GOTO Weiter4
  390.  IF monatflag%=1 THEN gesamtakt%=1:GOSUB Suchrutine4:GOTO Weiter4 
  391.  IF gesamtflag%=1  THEN gesamtakt%=1:GOSUB Suchrutine3:GOTO Weiter4
  392.  IF sortflag%=0 THEN GOSUB Suchrutine1  
  393.  IF sortflag%=1 THEN GOSUB Suchrutine2
  394. Weiter4:  
  395.  LOCATE 11,20:PRINT SPACE$(40)
  396.  LOCATE 13,20:PRINT SPACE$(40)
  397.  GOSUB Berechnung :IF z%=0 THEN RETURN
  398.  prozent%=bildzeilen/(z%/100):IF prozent%>100 THEN prozent%=100
  399.  LINE(10,37)-(25,37+prozent%),2,bf:GET(10,37)-(25,37+prozent%),balken%
  400.  mitte=prozent%/2:x=10:yx=37:showstart=1 
  401.  LOCATE 12,20:PRINT SPACE$(40) 
  402.  GOTO Listen1
  403.  
  404. Suchrutine1:    
  405.  
  406.  z%=0 
  407.  FOR y%=0 TO klg%
  408.  FOR x%=1 TO anzahl%
  409.    IF koliste%(y%)=VAL(LEFT$(ds$(x%),2)) THEN 
  410.      d$= MID$(ds$(x%),4,8)
  411.      IF zeitstart$=<d$ AND zeitende$>=d$ THEN
  412.        IF filterflag%=1 THEN
  413.          IF INSTR(ds$(x%),Filtertext$)>0 THEN
  414.            z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
  415.            gesamtbe=gesamtbe+w
  416.          END IF
  417.        ELSE
  418.            z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
  419.            gesamtbe=gesamtbe+w
  420.        END IF
  421.      END IF      
  422.    END IF
  423.  NEXT x%,y%
  424. RETURN
  425.  
  426. Suchrutine2:   
  427.  
  428.  z%=0
  429.  FOR x%=1 TO anzahl%
  430.    x1%= VAL(LEFT$(ds$(x%),1))
  431.    y1%= VAL(MID$(ds$(x%),2,1))
  432.    IF m%(x1%,y1%)=1 THEN 
  433.      d$= MID$(ds$(x%),4,8)
  434.      IF zeitstart$=<d$ AND zeitende$>=d$ THEN
  435.        IF filterflag%=1 THEN
  436.          IF INSTR(ds$(x%),Filtertext$)>0 THEN 
  437.            z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
  438.            gesamtbe=gesamtbe+w
  439.          END IF  
  440.        ELSE
  441.            z%=z%+1:show%(z%)=x%:w=VAL(RIGHT$(ds$(x%),10))
  442.            gesamtbe=gesamtbe+w
  443.        END IF
  444.      END IF
  445.    END IF
  446.  NEXT 
  447. RETURN
  448.  
  449. Suchrutine3: 
  450.  
  451.  ERASE gges:DIM gges(7,6)   
  452.    FOR x%=1 TO anzahl%
  453.    gh%=VAL(LEFT$(ds$(x%),1)):gu%=VAL(MID$(ds$(x%),2,1))
  454.    IF m%(gh%,gu%)=1 THEN
  455.      d$= MID$(ds$(x%),4,8)
  456.      IF zeitstart$=<d$ AND zeitende$>=d$ THEN
  457.        IF filterflag%=1 THEN
  458.          IF INSTR(ds$(x%),Filtertext$)>0 THEN 
  459.            w=VAL(RIGHT$(ds$(x%),10)):gges(gh%,gu%)=gges(gh%,gu%)+w
  460.            gesamtbe=gesamtbe+w:knum$(y%)=LEFT$(ds$(x%),2)
  461.            END IF
  462.          ELSE
  463.            w=VAL(RIGHT$(ds$(x%),10)):gges(gh%,gu%)=gges(gh%,gu%)+w
  464.            gesamtbe=gesamtbe+w:knum$(y%)=LEFT$(ds$(x%),2)  
  465.      END IF
  466.    END IF
  467.   END IF
  468.  NEXT x%
  469.  z%=0
  470.  GOSUB Wochentagberechnung
  471.  FOR y%=3 TO 7
  472.  FOR x%=1 TO 6
  473.  IF gges(y%,x%)<>0 THEN 
  474.  z%=z%+1
  475.  show$(z%)=RIGHT$(STR$(y%),1)+RIGHT$(STR$(x%),1)+" "+datum$
  476.  show$(z%)=show$(z%)+" "+wt$(wt%)+" "+m$(y%,x%)+" Gesamt "
  477.  show$(z%)=show$(z%)+zeitstart$+" bis "+zeitende$
  478.  show$(z%)=show$(z%)+"          "+STR$(gges(y%,x%))   
  479.  END IF
  480.  NEXT x%,y% 
  481. RETURN 
  482.  
  483. Suchrutine4:  
  484.  
  485.  jahre%=0
  486.  FOR x%=VAL(LEFT$(zeitstart$,2)) TO VAL(LEFT$(zeitende$,2))
  487.  jahre%=jahre%+1
  488.  NEXT 
  489.  IF jahre%>4 THEN RETURN
  490.  ERASE show$:DIM show$(12+(jahre%*12))
  491.  ERASE mges:DIM mges(jahre%-1,12)
  492.  FOR x%=1 TO anzahl%   
  493.      IF m%(VAL(LEFT$(ds$(x%),1)),VAL(MID$(ds$(x%),2,1)))=1 THEN
  494.      d$= MID$(ds$(x%),4,8)
  495.      IF zeitstart$=<d$ AND zeitende$>=d$ THEN
  496.        IF filterflag%=1 THEN
  497.          IF INSTR(ds$(x%),Filtertext$)>0 THEN 
  498.            w=VAL(RIGHT$(ds$(x%),10))
  499.            mon%=VAL(MID$(d$,4,2)):jahr%=VAL(LEFT$(d$,2))-VAL(LEFT$(zeitstart$,2))
  500.            mges(jahr%,mon%)=mges(jahr%,mon%)+w
  501.            gesamtbe=gesamtbe+w
  502.          END IF
  503.        ELSE
  504.            w=VAL(RIGHT$(ds$(x%),10))
  505.            mon%=VAL(MID$(d$,4,2)):jahr%=VAL(LEFT$(d$,2))-VAL(LEFT$(zeitstart$,2))
  506.            mges(jahr%,mon%)=mges(jahr%,mon%)+w
  507.            gesamtbe=gesamtbe+w
  508.        END IF
  509.      END IF   
  510.    END IF
  511.  NEXT x%           
  512.  z%=0
  513.  GOSUB Wochentagberechnung
  514.  FOR x%=0 TO jahre%-1
  515.  FOR y%=1 TO 12
  516.  IF mges(x%,y%)<>0 THEN 
  517.  z%=z%+1
  518.  show$(z%)="00 "+datum$+" "+wt$(wt%)+" Monatliche Abrechnung für "
  519.  show$(z%)=show$(z%)+monat$(y%)+STR$(VAL(LEFT$(zeitstart$,2))+x%)
  520.  show$(z%)=show$(z%)+"           "+STR$(mges(x%,y%))   
  521.  END IF
  522.  NEXT y%,x%
  523. RETURN 
  524.  
  525.  
  526. Filtertext:
  527.  
  528.  WINDOW 3,"Daten Filter",(50,55)-(580,123),0,1
  529.  meldung$="Bitte Text nach dem du suchen willst eingeben !"
  530.  center=34-(LEN(meldung$)/2)
  531.  LOCATE 2,center :PRINT meldung$ 
  532.  LINE (60,19)-(470,36),3,b:LINE(70,21)-(460,34),3,b:PAINT (62,25),3
  533.  LOCATE 4,11:laenge=40:msgs$=Filtertext$
  534.  type%=0:GOSUB Superinput:Filtertext$=msgs$
  535.  IF Filtertext$="" THEN Windowclose3
  536.  ttextrl=7:ttextrp=23:ttextfl=7:ttextfp=40:GOSUB Bestaetigung
  537.  mousep%=5:RETURN
  538. Mp5:
  539.  mousep%=0  
  540.  IF fehler=1 THEN Filtertext$=""
  541. GOTO Windowclose3
  542.  
  543. Selektieren:
  544.    
  545.  x%=0 :ok%=0
  546.  WHILE x%<=z% 
  547.  x%=x%+1 
  548.  IF calc%(x%)=1 THEN ok%=1
  549.  WEND 
  550.  IF ok%=0 THEN
  551.  fehlertext$="Ich habe keine Selektierten Daten gefunden !"
  552.  GOTO Fehlermeldung
  553.  END IF
  554.  LINE (36,22)-(625,151),0,bf:LINE(8,36)-(27,138),0,bf  
  555.  LOCATE 11,23:PRINT"Bitte Geduld ich selektiere Daten !"
  556.  selektflag=1
  557.  sz%=1:gesamtbe=0
  558.  FOR x%=1 TO z%
  559.  IF gesamtakt%=0 THEN
  560.    IF calc%(x%)=1 THEN
  561.    show%(sz%)=show%(x%) 
  562.    gesamtbe=gesamtbe+VAL(RIGHT$(ds$(show%(x%)),10)) 
  563.    sz%=sz%+1 
  564.    END IF
  565.  END IF
  566.  IF gesamtakt%=1 THEN
  567.    IF calc%(x%)=1 THEN
  568.    show$(sz%)=show$(x%)
  569.    gesamtbe=gesamtbe+VAL(RIGHT$(show$(x%),10))
  570.    sz%=sz%+1
  571.    END IF
  572.  END IF
  573.  NEXT 
  574.  IF gesamtakt%=0 THEN
  575.    FOR x%=sz% TO z%:show%(x%)=0:NEXT:z%=sz%-1 
  576.   ELSE
  577.    FOR x%=sz% TO z%:show$(x%)="":NEXT:z%=sz%-1
  578.  END IF
  579.  ERASE calc% :DIM calc%(datenmenge)
  580. GOTO Weiter4
  581.    
  582. Selloe:
  583.  
  584.  ERASE calc%:DIM calc%(datenmenge)
  585.  GOSUB Listen1
  586. RETURN
  587.  
  588. Selinv:
  589.  
  590.  FOR x%=1 TO z%:calc%(x%)=1-calc%(x%):NEXT
  591.  GOSUB Listen1
  592. RETURN 
  593.  
  594. Listen:
  595.  
  596.  showstart=INT((yx-37)*(z%/100))
  597.  IF showstart<1 OR yx<39 THEN showstart=1
  598.  IF prozent%<100 THEN
  599.  IF yx+prozent%>136 THEN showstart=z%-(bildzeilen-1)
  600.  END IF
  601. Listen1:
  602.  MOUSE OFF
  603.  LINE(35,22)-(626,151),0,bf:calcpos%=0
  604.  FOR calcnr%=showstart TO showstart+bildzeilen-1
  605.  GOSUB Listenprint
  606.  calcpos%=calcpos%+1
  607.  NEXT
  608.  summe=0:rechenwert=gesamtbe:calcmodus%=1
  609. RETURN 
  610.  
  611. Listenprint:
  612.  
  613.  IF calc%(calcnr%)=1 THEN COLOR 2:ELSE COLOR 1
  614.  LOCATE 4+calcpos%,6
  615.  IF gesamtakt%=0 THEN 
  616.    IF show%(calcnr%)<>0 THEN
  617.    rechenwert=VAL(RIGHT$(ds$(show%(calcnr%)),10))
  618.    texti$=MID$(ds$(show%(calcnr%)),3,LEN(ds$(show%(calcnr%)))-12)
  619.    CALL Text (WINDOW(8),SADD(texti$),LEN(texti$))
  620.    LOCATE 4+calcpos%,68:PRINT USING "#######.##";rechenwert
  621.    END IF
  622.  ELSE
  623.    IF show$(calcnr%)<>"" THEN
  624.    rechenwert=VAL(RIGHT$(show$(calcnr%),10))
  625.    texti$=MID$(show$(calcnr%),3,LEN(show$(calcnr%))-12)
  626.    CALL Text (WINDOW(8),SADD(texti$),LEN(texti$))   
  627.    LOCATE 4+calcpos%,68:PRINT USING "#######.##";rechenwert
  628.    END IF
  629.  END IF
  630.  COLOR 1
  631. RETURN
  632.  
  633. Korrbalken:
  634.  
  635.  PUT (10,yx),balken%
  636.  yx=(showstart-1)/z%*100+37
  637.  PUT (10,yx),balken%
  638. RETURN
  639.  
  640. Scrolldown:
  641.  
  642.  IF showstart<=1 THEN RETURN
  643.  showstart=showstart-1
  644.  GOSUB Korrbalken
  645.  calcpos%=0:calcnr%=showstart
  646.  SCROLL (36,24)-(625,151),0,8
  647.  GOSUB Listenprint
  648. RETURN
  649.  
  650.  
  651. Scrollup:
  652.  
  653.  IF showstart+bildzeilen-1>=z% THEN RETURN
  654.  showstart=showstart+1
  655.  GOSUB Korrbalken
  656.  calcpos%=bildzeilen-1:calcnr%=showstart+bildzeilen-1
  657.  SCROLL (36,24)-(625,151),0,-8
  658.  GOSUB Listenprint
  659. RETURN
  660.  
  661.  
  662.  
  663. Mousecheck:
  664.  
  665.  MENU OFF:x=MOUSE(0) 
  666.  IF ed%=1 THEN Mcp
  667.  IF kontenaktiv%=1 THEN Kontenmousecheck
  668.  IF mousep%>0 THEN Mouseposition
  669.  IF fakt%=1 THEN fakt%=0:GOTO Windowclose3
  670.  IF hilfeflag%=1 THEN hilfeflag%=0:MOUSE STOP :GOTO Windowclose3
  671.  IF WINDOW(0)=1 AND tabaktiv<>0 THEN
  672.  WINDOW 1 
  673.  IF MOUSE(1)>10 AND MOUSE(1)<25 AND MOUSE(2)>37 AND MOUSE(2)<137 THEN GOSUB Showzoom:GOTO Listen
  674. Scrollrepeat: 
  675.  IF MOUSE(3)>10 AND MOUSE(3)<25 THEN
  676.    IF MOUSE(4)>27 AND MOUSE(4)<37 THEN GOSUB Scrolldown
  677.    IF MOUSE(4)>137 AND MOUSE(4)<147 THEN GOSUB Scrollup   
  678.    IF MOUSE(0)=-1 THEN Scrollrepeat
  679.    RETURN
  680.  END IF
  681.  IF MOUSE(2)>157 AND MOUSE(2)<171 THEN Rechnerfunktion
  682.  IF MOUSE(2)>=24 AND MOUSE(2)<=150 AND MOUSE(1)>40 AND MOUSE(1)<620 THEN Rechner 
  683.  END IF
  684.  IF WINDOW(0)=2 AND grafikaktiv%=1 THEN
  685.  WINDOW 2
  686.  MOUSE STOP:GOTO Grafikselekt
  687.  END IF
  688. RETURN
  689.  
  690. Rechnertasten:
  691.  
  692.  COLOR 0,1
  693.  LOCATE 21,3:PRINT "ALT" :LOCATE 21,10:PRINT "CE":LOCATE 21,16:PRINT "IN"
  694.  LOCATE 21,22:PRINT "OUT":LOCATE 21,29:PRINT "+":LOCATE 21,35:PRINT "-";
  695.  PRINT PTAB(324)"*":LOCATE 21,48:PRINT "/":LOCATE 21,54:PRINT "="
  696.  COLOR 1,0
  697.  LOCATE 21,58:PRINT "Gesamt "waehrung$
  698. RETURN
  699.  
  700. Berechnung:
  701.  
  702.  LOCATE 21,68:PRINT USING "#######.##";gesamtbe:rechenwert=gesamtbe
  703.  IF tabaktuell=2 OR z%<>0 THEN RETURN
  704.  tagkorflag%=0
  705.  fehlertext$="Ich habe leider keine Daten gefunden"
  706.  IF jahre%>4 THEN jahre%=0:fehlertext$="Monatsabrechnungen können nur über 4 Jahre gehen !"
  707. GOTO Fehlermeldung
  708.  
  709. Showzoom:
  710.  
  711.  IF MOUSE(0)<=-1 THEN Weiter2
  712.  IF MOUSE(0)=0 THEN RETURN
  713. GOTO Showzoom
  714.  
  715. Weiter2:
  716.  IF MOUSE(1)< 0 OR MOUSE(1)>100 THEN Showzoom  
  717.  IF ABS(yx-(MOUSE(2)-mitte)) < 1 THEN Showzoom
  718.  GOSUB Movebalken
  719. GOTO Showzoom
  720.  
  721.  
  722. Movebalken:
  723.  PUT(10,yx),balken%
  724.  yx=MOUSE(2)-mitte
  725.  IF MOUSE(2)-mitte<37 THEN yx=37
  726.  IF MOUSE(2)+mitte>137 THEN yx=137-mitte*2
  727.  PUT(10,yx),balken%
  728. RETURN
  729.  
  730. Datumeingabe:
  731.  
  732.  LOCATE 9,20:PRINT SPACE$(20)
  733.  LOCATE 6,10:PRINT"Bitte Datum im Format JJ-MM-TT eingeben"
  734.  LOCATE 7,32:laenge=8:msgs$=datum$:type%=1
  735.  GOSUB Superinput:datum$=msgs$
  736.  IF datum$="" THEN fehler=3 :RETURN
  737.  fehlerpos=9:checkdat$=datum$
  738.  GOSUB Datumcheck:datum$=checkdat$
  739.  IF fehler=1 THEN fehler=0 :GOTO Datumeingabe
  740.  LOCATE 6,10:PRINT SPACE$(40)
  741.  LOCATE 7,30:PRINT SPACE$(20)
  742.  GOSUB Wochentagberechnung
  743.  MENU 1,4,1,"Datum ändern ("+datum$+") "
  744. RETURN
  745.  
  746. Wochentagberechnung:
  747.  
  748.  jj=1900+VAL(LEFT$(datum$,2)):mm=VAL(MID$(datum$,4,2)):tt=VAL(RIGHT$(datum$,2))
  749.  IF mm<3 THEN smj=(366+mm)-(INT(365.25*jj)-INT(365.25*(jj-1))):ELSE:smj=0
  750.  sj=INT(365.25*jj)-INT(jj/100)+INT(jj/400)+31*(mm-1)-INT(.4*mm+2.3-smj)+tt 
  751.  jj=sj+1721060&:wt%=jj-INT(jj/7)*7 
  752. RETURN
  753.   
  754. Menuleiste1:
  755.  MENU 1,0,1,"Arbeit"
  756.  MENU 1,1,1,"Tagesereignisse eingeben"
  757.  MENU 1,2,1,"Tagesereignisse ändern  "
  758.  MENU 1,3,1,"Zeitmaske eingeben      "
  759.  MENU 1,4,1,"Datum ändern ("+datum$+") " 
  760.  MENU 1,5,1,"Filtertext eingeben     " 
  761.  MENU 1,6,1,"Währungszeichen ändern  "
  762.  MENU 1,7,1,"Dateien verwalten       "
  763.  MENU 1,8,1,"Kontenlisten verwalten  "
  764.  MENU 1,9,1,"Daten sortieren         "
  765.  MENU 1,10,1,"Daten importieren       "
  766.  MENU 1,11,1,"Daten exportieren       "
  767.  MENU 1,12,1,"Systemstatus            "
  768.  MENU 1,13,1,"Hilfe  ( Beschreibung ) "
  769.  MENU 1,14,1,"Autor !!!!!!!!!!!!!!!!! "
  770.  MENU 1,15,1,"Programm beenden        "
  771. RETURN
  772.  
  773. Menuleiste2:
  774.  MENU 2,0,1,"Ausgabe"
  775.  MENU 2,1,m%(2,1),  "Tabelle Bildschirm   "
  776.  MENU 2,2,m%(2,2),  "Tabelle Drucken      "
  777.  MENU 2,3,m%(2,3),  "====================="
  778.  MENU 2,4,m%(2,4),  "  Alle Konten AN/AUS "
  779.  MENU 2,5,m%(2,5),  "  Gesamt             "
  780.  MENU 2,6,m%(2,6),  "  Detailiert         "
  781.  MENU 2,7,m%(2,7),  "  Filter     EIN/AUS "
  782.  MENU 2,8,m%(2,8),  "  Sortiert n. Konten "
  783.  MENU 2,9,m%(2,9),  "  Sortiert n. Datum  "
  784.  MENU 2,10,m%(2,10),"  Monatsabrechnung   "
  785.  MENU 2,11,m%(2,11),"====================="
  786.  MENU 2,12,m%(2,12),"Selektieren          "
  787.  MENU 2,13,m%(2,13),"Selekt invertieren   "  
  788.  MENU 2,14,m%(2,14),"Selekt löschen       " 
  789. RETURN
  790.  
  791.  
  792. Machkonten:
  793.  
  794.  allkonflag%=0:MENU 2,4,1
  795.  FOR x%=3 TO 7:MENU x%,0,0,"":NEXT
  796.  FOR leiste=3 TO ml%+2 :MENU leiste,0,1,m$(leiste,1) 
  797.  MENU leiste,1,m%(leiste,1)+1,"  "+LEFT$(m$(leiste,1)+"          ",9)
  798.  FOR x%=2 TO ma%(leiste)
  799.  MENU leiste,x%,m%(leiste,x%)+1,"  "+LEFT$(m$(leiste,x%)+"          ",9)
  800.  NEXT x%,leiste
  801.  
  802. RETURN
  803.  
  804. Msw2:
  805.   
  806.  IF punkte=5 THEN 
  807.    gesamtflag%=1:detailflag%=0:monatflag%=0
  808.    MENU 2,5,2:MENU 2,6,1:MENU 2,10,1 
  809.  END IF
  810.  IF punkte=6 THEN 
  811.    detailflag%=1:gesamtflag%=0:monatflag%=0
  812.    MENU 2,5,1:MENU 2,6,2:MENU 2,10,1
  813.  END IF  
  814.  IF punkte=10 THEN 
  815.    monatflag%=1:gesamtflag%=0:detailflag%=0
  816.    MENU 2,10,2:MENU 2,6,1:MENU 2,5,1
  817.  END IF  
  818.  IF punkte=8 THEN sortflag%=0:MENU 2,8,2:MENU 2,9,1
  819.  IF punkte=7 THEN filterflag%=1-filterflag%:MENU 2,7,filterflag%+1
  820.  IF punkte=9 THEN sortflag%=1:MENU 2,8,1:MENU 2,9,2
  821.  IF punkte=4 THEN 
  822.    allkonflag%=1-allkonflag%:tabaktuell=2-allkontenflag%*2:MENU 2,4,allkonflag%+1
  823.    tabaktuell=0
  824.    FOR x%=3 TO ml%+2
  825.    FOR y%=1 TO ma%(x%)
  826.    IF m$(x%,y%)<>"" THEN m%(x%,y%)=allkonflag%:MENU x%,y%,allkonflag%+1
  827.    NEXT y%,x%
  828.  END IF
  829. RETURN
  830.  
  831.   
  832. Menurefresh:
  833.    
  834.  tabaktuell=0
  835.  IF punkte<2 THEN 
  836.    m%(leiste,1)=1-m%(leiste,1)
  837.    FOR x%=1 TO ma%(leiste)
  838.      m%(leiste,x%)=m%(leiste,1)
  839.      IF m$(leiste,x%)<>"" THEN MENU leiste,x%,m%(leiste,x%)+1
  840.    NEXT
  841.   ELSE:
  842.    m%(leiste,punkte)=1-m%(leiste,punkte)
  843.    IF m$(leiste,punkte)<>"" THEN MENU leiste,punkte,m%(leiste,punkte)+1 
  844.  END IF
  845. RETURN
  846.  
  847. Kontenliste:
  848.  
  849.  ERASE koliste%:ERASE koliste$:DIM koliste$(30):DIM koliste%(30)
  850.  klg%=0
  851.  FOR x%=3 TO ml%+2:FOR y%=2 TO ma%(x%)
  852.  IF m%(x%,y%)=1 THEN
  853.  klg%=klg%+1
  854.  koliste$(klg%)=m$(x%,y%)
  855.  koliste%(klg%)=x%*10+y% 
  856.  END IF
  857.  NEXT y%,x%
  858. RETURN
  859.  
  860. Zeitmaske:
  861.  
  862.  WINDOW 3,"Zeitmaske eingeben",(80,35)-(550,150),0,1  
  863.  LOCATE 3,8:PRINT "Aktuelle Zeitmaske von "zeitstart$" bis "zeitende$" 
  864. 1200 fehler=0: LOCATE 6,14:PRINT "Ausgaben vom (JJ-MM-TT) ";
  865.  laenge=8:msgs$=zeitstart$:type%=1:GOSUB Superinput :checkdat$=msgs$
  866.  IF checkdat$="" THEN Windowclose3 
  867.  fehlerpos=10:GOSUB Datumcheck
  868.  IF fehler=1 THEN GOTO 1200
  869.  zeitstart$=msgs$
  870. 1201 fehler=0: LOCATE 8,23:PRINT "bis (JJ-MM-TT) ";
  871.  laenge=8:msgs$=zeitende$:type%=1:GOSUB Superinput :checkdat$=msgs$
  872.  IF checkdat$="" THEN Windowclose3 
  873.  fehlerpos=10:GOSUB Datumcheck
  874.  IF fehler=1 THEN GOTO 1201
  875.  zeitende$=msgs$
  876.  ttextrl=12:ttextrp=18:ttextfl=12:ttextfp=35:GOSUB Bestaetigung
  877.  mousep%=6:RETURN
  878. Mp6:
  879.  mousep%=0 
  880.  IF fehler=1 THEN GOTO Zeitmaske
  881.  WINDOW 1:GOSUB Tabkopf
  882.  GOSUB Systemsetsave
  883. GOTO Windowclose3
  884.  
  885.  
  886. Datumcheck: 
  887.  
  888.  jj$=(LEFT$(checkdat$,2)):mm$=(MID$(checkdat$,4,2)):tt$=(RIGHT$(checkdat$,2))
  889.  jj=VAL(jj$):mm=VAL(mm$):tt=VAL(tt$)
  890.  IF LEN(checkdat$)>8 OR LEN(checkdat$)<8 THEN Datumfehler
  891.  IF MID$(checkdat$,3,1)<> "-" OR MID$(checkdat$,6,1)<> "-" THEN Datumfehler
  892.  IF checkdat$<dzeitstart$ OR checkdat$>dzeitende$ THEN Datumfehler
  893.  IF jj<80 OR jj>99 THEN Datumfehler
  894.  IF mm<1 OR mm>12 THEN Datumfehler
  895.  IF tt<1 OR tt>31 THEN Datumfehler
  896. RETURN
  897.  
  898. Datumfehler:
  899.  
  900.  fehler =1 
  901.  LOCATE fehlerpos,5:PRINT SPACE$(40)
  902.  LOCATE fehlerpos,24:PRINT"Datum falsch"
  903.  FOR x=1 TO 1000:NEXT 
  904.  LOCATE fehlerpos,24:PRINT SPACE$(13) 
  905. RETURN
  906.  
  907. Mouseclick:
  908.  
  909.  MOUSE OFF
  910.  dummy=MOUSE(0)
  911.  WHILE MOUSE(0)<>-1:SLEEP:WEND 
  912.  dummy=MOUSE(3):dummy=MOUSE(3)
  913.  MOUSE ON
  914. RETURN
  915.  
  916. Ende:
  917.  
  918. GOSUB Windowclose3:CLS:LIBRARY CLOSE:END
  919.  
  920. Progende:
  921.  
  922.  windowtext$="Programm beenden :":GOSUB Openwindow3
  923.  LOCATE 4,25:PRINT "Good bye !"
  924.  ttextrl=7:ttextrp=18:ttextfl=7:ttextfp=35:GOSUB Bestaetigung
  925.  mousep%=7:RETURN
  926. Mp7:
  927.  mousep%=0  
  928.  IF fehler=0 THEN Ende
  929. GOTO Windowclose3
  930.  
  931. Operationsmeldung:
  932.  
  933.  WINDOW CLOSE 3
  934.  WINDOW 3,"Operationsmeldung",(122,80)-(512,118),0,1 
  935.  center=25-(LEN(operationstext$)/2)
  936.  LOCATE 3,center :PRINT operationstext$ 
  937.  IF flag=1 THEN flag=0:RETURN
  938.  GOSUB Mouseclick
  939. GOTO Windowclose3
  940.  
  941. Fehlermeldung:
  942.   
  943.  SOUND 1500,2,255,3:fakt%=1
  944.  WINDOW 3,"Fehlerdiagnose",(82,80)-(552,120),0,1 
  945.  center1=1
  946.  center=30-(LEN(fehlertext$)/2)
  947.  IF fehlertext1$<>"" THEN center1=30-(LEN(fehlertext1$)/2)
  948.  LOCATE 3,center :COLOR 2:PRINT fehlertext$:COLOR 1 
  949.  LOCATE 4,center1:COLOR 2:PRINT fehlertext1$:COLOR 1
  950.  fehlertext1$="":fehlertext$=""
  951.  fehlerflag=1  
  952.  IF diskfehler=4 THEN GOSUB Mouseclick
  953. RETURN
  954.  
  955.  
  956. Fehlerdiagnose:
  957.  
  958. IF ERR=61 THEN 
  959.  fehlertext$="Diskette voll ! Bitte auf DIESER Platz schaffen !"
  960.  diskfehler=4
  961.  RESUME NEXT
  962. END IF
  963.  
  964. IF ERR=70 THEN
  965.   fehlertext$="Ihre Diskette ist schreibgeschützt."
  966.   fehlertext1$="Bitte Schreibschutz entfernen !"
  967.   diskfehler=4
  968.   RESUME NEXT
  969. END IF  
  970.  
  971. IF ERR=53 THEN 
  972. fehlertext$="Ich kann diese Datei nicht finden !"
  973. diskfehler=1:RESUME NEXT
  974. END IF
  975.  
  976. IF ERR=68 THEN 
  977.  fehlertext$="Mit dem Drucker stimmt etwas nicht !"
  978.  druckfehler=1
  979.  RESUME NEXT
  980. END IF
  981.  
  982. IF ERR=6 OR ERR=68 OR ERR=11 OR ERR=58 THEN RESUME NEXT
  983. IF ERR=57 THEN RESUME Windowclose3
  984.  
  985. IF ERR=23 OR ERR=15 THEN 
  986.  fehlertext$="Schadhafte Datei ! (Korrigieren mit 'Ed')"
  987.  GOSUB Fehlermeldung
  988.  diskfehler=2 
  989.  RESUME Windowclose3
  990. END IF
  991.  
  992. IF ERR=64 THEN 
  993.  fehlertext$="Falscher Dateiname !"
  994.  GOSUB Fehlermeldung
  995.  diskfehler=1:CLOSE #2
  996.  RESUME NEXT
  997. END IF
  998.  
  999. IF ERR=5 OR ERR=52 THEN 
  1000.  diskfehler=2:CLOSE #2
  1001.  fehlertext$="Falsche Dateinummer"
  1002.  RESUME NEXT
  1003. END IF
  1004.  
  1005. IF ERR=55 THEN CLOSE #2:CLOSE #3:RESUME NEXT
  1006. IF ERR=14 OR ERR=7 THEN RESUME Outoffmem
  1007. ON ERROR GOTO 0
  1008.  
  1009. Tabmaske: 
  1010.  
  1011.  GOSUB Screendown
  1012.  CLS
  1013.  LINE(3,21)-(32,152),3,b:LINE(4,21)-(31,152),3,b 
  1014.  FOR x=1 TO 2  
  1015.   LINE(5-x,5-x)-(625+x,17+x),3,b
  1016.   LINE(5-x,156-x)-(625+x,170+x),3,b
  1017.   LINE(33+x,21)-(625+x,152),3,b  
  1018.  NEXT
  1019.  y=158:y1=168:FOR x=10 TO 410 STEP 50 
  1020.  LINE(x,y)-(x+35,y1),1,bf:LINE (x,y)-(x+35,y1),3,b:LINE(x+1,y)-(x+34,y1),3,b
  1021.  NEXT
  1022.  LINE(7,35)-(28,139),3,b:PAINT(6,33),1,3  
  1023.  LINE(15,31)-(21,34),0,bf:LINE(11,31)-(18,28),0:LINE -(25,31),0:LINE -(11,31),0
  1024.  LINE(15,140)-(21,143),0,bf:LINE(11,143)-(18,146),0:LINE -(25,143),0:LINE -(11,143),0 
  1025.  PAINT(18,30),0:PAINT(18,144),0
  1026.  tabaktiv=1
  1027.  GOSUB Rechnertasten
  1028.  GOSUB Tabkopf
  1029.  GOSUB Bildein
  1030.  GOSUB Screenup
  1031. RETURN
  1032.  
  1033. Tabkopf:
  1034.  
  1035.  LOCATE 2,3:PRINT dateiname$
  1036.  LOCATE 2,37:PRINT "Aktuelle Zeitmaske: "zeitstart$" bis "zeitende$
  1037. RETURN 
  1038.  
  1039. Bildein:
  1040.  
  1041.  speed=10 
  1042.  FOR y%=speed TO 1 STEP-1  
  1043.  FOR x%=0 TO 7
  1044.  PALETTE x%,r(x%)/y%,g(x%)/y%,b(x%)/y%
  1045.  NEXT x%,y%  
  1046. RETURN
  1047.  
  1048. Bildaus:
  1049.  
  1050.  speed=1000 
  1051.  FOR y%=1 TO speed STEP 100  
  1052.  FOR x%=0 TO 7
  1053.  PALETTE x%,r(x%)/y%,g(x%)/y%,b(x%)/y% 
  1054.  NEXT x%,y%
  1055. RETURN
  1056.  
  1057. Rechner:
  1058.  
  1059.  calcpos%=INT((MOUSE(2)-24)/8) 
  1060.  calcnr%=showstart+calcpos%:calc%(calcnr%)=1-calc%(calcnr%)
  1061.  IF tagkorflag%=1 THEN Tagkor1
  1062.  GOSUB Listenprint
  1063.  GOSUB Summenprint
  1064. RETURN
  1065.  
  1066. Summenprint:
  1067.  
  1068.  IF rechenwert<-999999& OR rechenwert>9999999& THEN fehler=1
  1069.  IF summe<-999999& OR summe>9999999& THEN fehler=1
  1070.  IF fehler=1 THEN
  1071.   LOCATE 21,68:PRINT SPACE$(10):LOCATE 21,71 :PRINT "ERROR" :fehler=0 
  1072.   IF funktion<10 THEN y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b
  1073.   summe=0:rechenwert=0 
  1074.   RETURN
  1075.  END IF
  1076.  IF calcmodus%<>0 THEN 
  1077.  LOCATE 21,68:PRINT USING "#######.##";rechenwert
  1078.  ELSE
  1079.  LOCATE 21,68:PRINT USING "#######.##";summe
  1080.  END IF
  1081. RETURN 
  1082.  
  1083. Rechnerfunktion:
  1084.  
  1085.  funktion=INT((MOUSE(1)-5)/50+1)
  1086.   IF funktion>9 THEN
  1087.    LOCATE 21,68:PRINT SPACE$(10):LOCATE 21,68:laenge=10
  1088.    type%=1:msgs$="":GOSUB Superinput
  1089.    rechenwert=VAL(msgs$)  
  1090.    IF calcmodus%=0 THEN calcmodus%=1
  1091.    GOSUB Summenprint
  1092.    RETURN
  1093.  END IF 
  1094.  IF funktion<10 THEN
  1095.  y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),2,b
  1096.  END IF
  1097.  IF funktion=1 THEN rechenwert=gesamtbe:GOSUB Summenprint:GOTO Weiter29
  1098.  IF funktion=2 THEN Loeschen
  1099.  IF funktion=3 THEN 
  1100.    IF calcmodus%<>0 THEN speicherwert=rechenwert:ELSE:speicherwert=summe
  1101.  END IF  
  1102.  IF funktion=4 THEN rechenwert=speicherwert:GOSUB Summenprint:GOTO Weiter29
  1103.  IF funktion<10 THEN
  1104.      IF calcmodus%=1 THEN summe=summe+rechenwert  
  1105.      IF calcmodus%=2 THEN summe=summe-rechenwert  
  1106.      IF calcmodus%=3 THEN summe=summe*rechenwert  
  1107.      IF calcmodus%=4 THEN 
  1108.        IF rechenwert=0 THEN
  1109.          fehler=1 :GOSUB Summenprint :RETURN
  1110.        END IF
  1111.        summe=summe/rechenwert  
  1112.      END IF
  1113.      rechenwert=0
  1114.      calcmodus%=0
  1115.      GOSUB Summenprint
  1116.  END IF
  1117.  IF funktion>4 AND funktion<9 THEN calcmodus%=funktion-4
  1118. Weiter29:
  1119.  IF funktion<10 THEN
  1120.  y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b
  1121.  END IF
  1122. RETURN
  1123.  
  1124. Loeschen:
  1125.  
  1126.  calcmodus%=1
  1127.  IF funktion<9 THEN
  1128.  y0=158:y1=168:x=50*(funktion-1)+10:LINE(x,y0)-(x+35,y1),3,b
  1129.  END IF
  1130.  rechenwert=0:summe=0:GOSUB Summenprint 
  1131. RETURN
  1132.  
  1133. Superinput:
  1134.  
  1135.  WHILE INKEY$<>"":WEND              
  1136.  GOSUB Spacekiller
  1137.  msgs$=LEFT$(msgs$,laenge)
  1138.  GOSUB Editor
  1139.  GOSUB Spacekiller 
  1140.  type%=0
  1141. RETURN
  1142.  
  1143. Spacekiller:
  1144.  
  1145.  IF msgs$=" " OR msgs$="" THEN msgs$="":RETURN
  1146.  WHILE MID$(msgs$,LEN(msgs$),1)=" " AND LEN(msgs$)>1
  1147.  msgs$=LEFT$(msgs$,LEN(msgs$)-1)
  1148.  WEND
  1149.  
  1150. RETURN 
  1151.  
  1152.  
  1153. Bestaetigung:
  1154.  
  1155.  MOUSE OFF 
  1156.  IF request%=3 THEN LOCATE ttextwl,ttextwp:COLOR 1:PRINT"Weiter"
  1157.  LOCATE ttextrl,ttextrp:COLOR 1:PRINT"Richtig":
  1158.  LOCATE ttextfl,ttextfp:COLOR 2:PRINT"Falsch":COLOR 1
  1159.  IF request%=3 THEN txwpos%=ttextwp*8-22:tywpos%=ttextwl*8-13
  1160.  txrpos%=ttextrp*8-19:tyrpos%=ttextrl*8-13
  1161.  txfpos%=ttextfp*8-22:tyfpos%=ttextfl*8-13
  1162.  IF request%=3 THEN
  1163.  LINE(txwpos%,tywpos%)-(txwpos%+75,tywpos%+17),3,b
  1164.  LINE(txwpos%+4,tywpos%+2)-(txwpos%+71,tywpos%+15),3,b
  1165.  END IF
  1166.  LINE(txrpos%,tyrpos%)-(txrpos%+75,tyrpos%+17),3,b
  1167.  LINE(txrpos%+4,tyrpos%+2)-(txrpos%+71,tyrpos%+15),3,b
  1168.  LINE(txfpos%,tyfpos%)-(txfpos%+75,tyfpos%+17),3,b
  1169.  LINE(txfpos%+4,tyfpos%+2)-(txfpos%+71,tyfpos%+15),3,b
  1170. RETURN 
  1171.  
  1172. Mouseposition:
  1173.  
  1174.  fehler=3:IF hlf%=1 THEN Weiter27
  1175.  xpos=MOUSE(3): ypos=MOUSE(4)
  1176.  IF request%=3 THEN
  1177.  IF xpos>txwpos% AND xpos<txwpos%+75 AND ypos>tywpos% AND ypos<tywpos%+17 THEN fehler=2
  1178.  END IF
  1179.  IF xpos>txrpos% AND xpos<txrpos%+75 AND ypos>tyrpos% AND ypos<tyrpos%+17 THEN fehler=0
  1180.  IF xpos>txfpos% AND xpos<txfpos%+75 AND ypos>tyfpos% AND ypos<tyfpos%+17 THEN fehler=1
  1181.  IF request%=3 AND fehler=2 THEN PAINT(txwpos%+2,tywpos%+2),1,3 
  1182.  IF fehler=0 THEN PAINT(txrpos%+2,tyrpos%+2),1,3 
  1183.  IF fehler=1 THEN PAINT(txfpos%+2,tyfpos%+2),2,3
  1184.  IF fehler=3 OR kontenaktiv%=1 THEN RETURN
  1185. Weiter27:
  1186.  ON mousep% GOTO Mp1,Mp2,Mp3,Mp4,Mp5,Mp6,Mp7,Mp8,Mp9,Mp10,Mp11,Mp12,Mp13,Mp14,Mp15,Mp16,Mp17,Mp18
  1187.  
  1188. Sort:
  1189.  
  1190.  MOUSE OFF:MENU OFF 
  1191.  WINDOW 3,"Daten sortieren",(50,50)-(580,100),0,1 
  1192.  meldung$="Du willst nun die Datei "+MID$(dateiname$,16,16)+" sortieren !"
  1193.  center=33-(LEN(meldung$)/2)
  1194.  LOCATE 2,center :PRINT meldung$ 
  1195.  ttextrl=5:ttextrp=23:ttextfl=5:ttextfp=40:GOSUB Bestaetigung
  1196.  mousep%=8:RETURN
  1197. Mp8:
  1198.  mousep%=0  
  1199.  IF fehler=1 AND tagkorflag%=0 THEN Windowclose3
  1200.  IF fehler=1 THEN Weiter17
  1201.  operationstext$="Ich sortiere nun die Daten ! Bitte Geduld !"
  1202.  flag=1:GOSUB Operationsmeldung
  1203.  GOSUB Bubblesort
  1204. Weiter17:
  1205.  operationstext$="Ich speichere nun die Daten !"
  1206.  flag=1:GOSUB Operationsmeldung
  1207.  GOSUB Rueckschreiben:GOSUB Windowclose3
  1208.  GOSUB Tabmaske
  1209.  IF tagkorflag%=1 THEN tagkorflag%=0
  1210. GOTO Tabausgabe
  1211.  
  1212. Tabprint:
  1213.  
  1214.  MOUSE OFF 
  1215.  FOR x%=3 TO 7 :m%(x%,0)=m%(x%,1) :NEXT            
  1216.  IF tabaktuell=0 THEN 
  1217.   fehlertext$="Bitte vor Ausdruck Tabelle aktualisieren !":GOTO Fehlermeldung
  1218.  END IF
  1219.  IF z%=0 THEN 
  1220.   fehlertext$="Keine Daten zum Drucken vorhanden !":GOTO Fehlermeldung
  1221.  END IF 
  1222.  printakt%=1:GOSUB Bildaus
  1223.  CLS
  1224.  IF sortflag%=0 THEN smodus$="sortiert nach Konten"
  1225.  IF sortflag%=1 THEN smodus$="sortiert nach Datum" 
  1226.  IF detailflag%=1 THEN prtmodus$="detailiert"
  1227.  IF gesamtflag%=1 THEN prtmodus$="im Gesamten":smodus$=""
  1228.  IF filterflag%=1 THEN prtmodus$="gefiltert"
  1229.  IF monatflag%=1 THEN prtmodus$="als Monatsabrechnung":smodus$=""
  1230.  LOCATE 2,7:PRINT"Es werden die Eintragungen der markierten Konten "smodus$    
  1231.  FOR x%=3 TO 7:y%=0:LOCATE 4,(x%-3)*13+10:GOSUB Markieren1: NEXT x%     
  1232.  FOR y%=2 TO 6
  1233.   FOR x%=3 TO 7 :LOCATE y%+4,10+(x%-3)*13:GOSUB Markieren1: NEXT x% 
  1234.   COLOR 1 
  1235.  NEXT y%
  1236.  LOCATE 12,9
  1237.  PRINT "In der Zeit von "zeitstart$" bis "zeitende$" "prtmodus$" ausgedruckt !"
  1238.  LOCATE 14,5:PRINT"Datum (JJ-MM-TT):"  
  1239.  LOCATE 14,32:PRINT"Kommentar:"  
  1240.  GOSUB Bildein
  1241.  LOCATE 14,22:laenge=8:msgs$=pdatum$:GOSUB Superinput: pdatum$=msgs$ 
  1242.  LOCATE 14,42:laenge=34:msgs$=pkom$:GOSUB Superinput: pkom$=msgs$
  1243.  ttextrl=18:ttextrp=28:ttextfl=18:ttextfp=45:GOSUB Bestaetigung
  1244.  mousep%=9:RETURN
  1245. Mp9:
  1246.  mousep%=0  
  1247.  IF fehler=1 THEN 
  1248.  printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe
  1249.  END IF 
  1250.  operationstext$="Drucker arbeitet : Abbruch durch (ESC)" 
  1251.  flag=1:GOSUB Operationsmeldung 
  1252.   
  1253.  pagenr= INT((z%-41)/60)+2 
  1254.  pagel%=72                        
  1255.  pagec=1                          
  1256.  plr%=10 :prr%=plr%+86            
  1257.  IF FRE(-1)<30000& THEN 
  1258.  GOSUB Outoffmem:GOSUB Windowclose3
  1259.  printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe
  1260.  END IF
  1261.  OPEN "prt:" FOR OUTPUT AS #1
  1262.  PRINT #1,CHR$(27)"c";            
  1263.  PRINT #1,CHR$(27)"#1";           
  1264.  PRINT #1,CHR$(27)"[1z";           
  1265.  PRINT #1,CHR$(27)"[";pagel%;"t"; 
  1266.  PRINT #1,CHR$(27)"[2w";          
  1267.  PRINT #1,CHR$(27)"(K";          
  1268.  PRINT #1,CHR$(27)"[6w";         
  1269.  PRINT #1,CHR$(27)"[1m";          
  1270.  PRINT #1,CHR$(27)"[2"CHR$(34)"z";          
  1271.  PRINT #1,CHR$(27)"[4m"           
  1272.  PRINT #1,"Auflistung der Tabelle nach Konten und Zeit"
  1273.  PRINT #1,CHR$(27)"[24m";        
  1274.  PRINT #1,CHR$(27)"[5w";          
  1275.  PRINT #1,CHR$(13) 
  1276.  PRINT #1,"Tabelle vom ";
  1277.  PRINT #1,USING "\      \";pdatum$;:PRINT #1,"    ";
  1278.  PRINT #1,USING "\                                              \";pkom$;
  1279.  PRINT #1,"Seite 1 von"pagenr
  1280.  GOSUB Strich 
  1281.    
  1282.  PRINT #1,"Es werden die Eintragungen der markierten Konten "smodus$
  1283.  PRINT #1,CHR$(13)
  1284.  FOR x%=3 TO 7 :y%=0: GOSUB Markieren :NEXT      
  1285.  PRINT #1,CHR$(13)
  1286.  GOSUB Strich
  1287.  FOR y%=2 TO 6
  1288.   FOR x%=3 TO 7 :GOSUB Markieren
  1289.   NEXT x% 
  1290.   PRINT #1,CHR$(13)
  1291.  NEXT y%
  1292.  GOSUB Strich
  1293.  PRINT #1,"In der Zeit von "zeitstart$" bis einschließlich "zeitende$" "prtmodus$" ausgedruckt !" 
  1294.  GOSUB Strich
  1295.  PRINT #1,CHR$(27)"[22m";
  1296.  x%=0
  1297.  
  1298.  WHILE x%<z%
  1299.   x%=x%+1  
  1300.   FOR v%=41 TO datenmenge+200 STEP 60
  1301.    IF x%=v% THEN GOSUB Umblaettern  
  1302.   NEXT
  1303.   PRINT #1,USING "###";x%;:PRINT #1,"  "; 
  1304.   IF gesamtakt%=0 THEN
  1305.    PRINT #1,USING "\                                                                      \";MID$(ds$(show%(x%)),3,LEN(ds$(show%(x%)))-12);
  1306.    IF VAL(RIGHT$(ds$(show%(x%)),10))<>0 THEN
  1307.     PRINT #1,USING "#######.##";VAL(RIGHT$(ds$(show%(x%)),10));
  1308.    END IF
  1309.   ELSE 
  1310.   PRINT #1,USING "\                                                                      \";MID$(show$(x%),3,LEN(show$(x%))-12);
  1311.   IF VAL(RIGHT$(show$(x%),10))<>0 THEN
  1312.    PRINT #1,USING "#######.##";VAL(RIGHT$(show$(x%),10));
  1313.   END IF
  1314.   END IF
  1315.   PRINT #1,CHR$(13)
  1316.   IF INKEY$=CHR$(27) THEN Abbruch
  1317.  WEND 
  1318.  GOSUB Strich
  1319.  PRINT #1,"Im Gesamten wurden für die gewählten Konten laut Zeitmaske ";
  1320.  PRINT #1,CHR$(27)"[1m";
  1321.  PRINT #1,USING "########.##";gesamtbe;
  1322.  PRINT #1,CHR$(27)"[22m";
  1323.  PRINT #1," "waehrung$" aufgewendet !"
  1324.  GOSUB Strich
  1325.  GOSUB Seitenumbruch
  1326.  CLOSE #1 
  1327.  operationstext$="Druckoperation fertig !":GOSUB Operationsmeldung
  1328.  printakt%=0:GOSUB Tabmaske:GOTO Tabausgabe
  1329.  
  1330. Markieren:
  1331.  
  1332.   IF m%(x%,y%)=1 THEN
  1333.     mp$(x%,y%)="* "+m$(x%,y%)
  1334.     PRINT #1,CHR$(27)"[1m";
  1335.   ELSE 
  1336.     mp$(x%,y%)="  "+m$(x%,y%)
  1337.     PRINT #1,CHR$(27)"[22m";
  1338.   END IF
  1339.       PRINT #1,USING "\               \" ;mp$(x%,y%);
  1340. RETURN
  1341.  
  1342. Markieren1:
  1343.  
  1344.   IF m%(x%,y%)=1 THEN  
  1345.    COLOR 2
  1346.     ELSE
  1347.    COLOR 1
  1348.   END IF
  1349.   CALL Text (WINDOW(8),SADD(m$(x%,y%)),LEN(m$(x%,y%)))
  1350. RETURN 
  1351.  
  1352.  
  1353. Abbruch:
  1354.  
  1355.  CLOSE #1 
  1356.  fehlertext$="Druckoperation abgebrochen !":GOSUB Fehlermeldung 
  1357.  printakt%=0:GOSUB Tabmaske:tabaktiv=0:GOTO Tabausgabe 
  1358.  
  1359. Strich: 
  1360.  
  1361.  FOR y%=1 TO 87:PRINT #1,"_";:NEXT:PRINT #1,CHR$(13):PRINT #1,CHR$(13)
  1362. RETURN 
  1363.  
  1364. Umblaettern:
  1365.  
  1366.  IF z%=40+(60*(pagenr-1)) THEN RETURN
  1367.  GOSUB Strich :pagec=pagec+1
  1368.  PRINT #1,CHR$(27)"[1m";
  1369.  FOR y%=1 TO 5:PRINT #1,CHR$(13):NEXT
  1370.  GOSUB Strich
  1371.  PRINT #1,"Tabelle vom ";
  1372.  PRINT #1,USING "\      \";pdatum$;
  1373.  PRINT #1,"    ";
  1374.  PRINT #1,USING "\                                  \";pkom$;
  1375.  PRINT #1,"   (Fortsetzung)   Seite ";
  1376.  PRINT #1,USING "##";pagec;
  1377.  GOSUB Strich
  1378.  PRINT #1,CHR$(27)"[22m"; 
  1379. RETURN
  1380.  
  1381. Seitenumbruch:
  1382.  
  1383.  vz%= (pagenr*60+5-z%)-20:IF pagenr=1 THEN vz%=45-z%
  1384.  FOR y%=1 TO vz% :PRINT #1,CHR$(27)"d":NEXT
  1385. RETURN
  1386.  
  1387. Bubblesort:
  1388.  
  1389.  sortlg%=INT(anzahl%/2)+1:sortrg%=anzahl%
  1390. Loop1:
  1391.  IF sortrg%<=1 THEN GOTO Windowclose3
  1392. Loop2:
  1393.  IF sortlg%<=1 THEN Loop3
  1394.  sortlg%=sortlg%-1
  1395.  sorti%=sortlg%:GOTO Loop4
  1396. Loop3:
  1397.  SWAP ds$(1),ds$(sortrg%) 
  1398.  sortrg%=sortrg%-1
  1399.  sorti%=1
  1400. Loop4:
  1401.  sortx$=ds$(sorti%)
  1402.  sortp%=0
  1403. Loop5:
  1404.  IF 2*sorti%<=sortrg% AND sortp%=0 THEN Loop6
  1405.  ds$(sorti%)=sortx$
  1406.  GOTO Loop1
  1407. Loop6:
  1408.  sortj%=2*sorti%
  1409.  IF sortj%<sortrg% THEN
  1410.    IF MID$(ds$(sortj%),4,8)<MID$(ds$(sortj%+1),4,8) THEN sortj%=sortj%+1
  1411.  END IF
  1412.  IF MID$(sortx$,4,8)>=MID$(ds$(sortj%),4,8) THEN Loop7
  1413.  ds$(sorti%)=ds$(sortj%)
  1414.  sorti%=sortj%:GOTO Loop5
  1415. Loop7:
  1416.  sortp%=1:GOTO Loop5
  1417.  
  1418.  
  1419. Variablendim:
  1420.  
  1421.  DIM m$(8,8)
  1422.  DIM monat$(12)
  1423.  DIM kontoart$(8,8)
  1424.  DIM hilfefile$(2,15)
  1425.  DIM mp$(7,7),ma%(7)
  1426.  DIM m%(7,15) 
  1427.  DIM koliste%(30)
  1428.  DIM koliste$(30)
  1429.  DIM knum$(30)
  1430.  DIM kges(88)
  1431.  DIM gges(88)
  1432.  DIM mges(1,12) 
  1433.  DIM balken%(310)
  1434.  DIM c%(64),cs%(64)
  1435.  DIM dsmem$(50)
  1436.  DIM show$(26)
  1437.  datenmenge=INT((FRE(0)-5000)/108)
  1438.  IF datenmenge>999 THEN datenmenge=999
  1439.  DIM ds$(datenmenge),show%(datenmenge)
  1440.  DIM calc%(datenmenge)
  1441.  DIM sortlg%(datenmenge)
  1442.  DIM sortrg%(datenmenge)
  1443. RETURN
  1444.  
  1445. Datalesen:
  1446.  
  1447.  RESTORE Monatsnamen
  1448.  FOR x%=1 TO 12:READ monat$(x%)
  1449.  NEXT
  1450.  RESTORE Wochentage
  1451.  FOR x%=0 TO 6:READ wt$(x%)
  1452.  NEXT 
  1453.  RESTORE Hilfefiledatas
  1454.  FOR y%=0 TO 1:FOR x%=0 TO 14
  1455.  READ hilfefile$(y%,x%)
  1456.  NEXT x%,y%
  1457. RETURN
  1458.  
  1459. Farbeinstellung:
  1460.  
  1461.  RESTORE Farben
  1462.  FOR x%=0 TO 7:READ r(x%),g(x%),b(x%):PALETTE x%,r(x%),g(x%),b(x%):NEXT
  1463. RETURN
  1464.  
  1465. Hilfefiledatas:
  1466.  
  1467.  DATA Konten,Eingeben,Eingaben ändern,Zeitmaske
  1468.  DATA Datum ändern,Filtertext,Währung,Dateien
  1469.  DATA Kontenlisten,Sortieren,Importieren
  1470.  DATA Exportieren,,,,,Tabelle Bildschirm,Tabelle Drucken,
  1471.  DATA Alle Konten,Gesamt,Detailiert,Filter
  1472.  DATA Sort.n.Konten,Sort.n.Datum,Monatsabrechnung,,
  1473.  DATA Selektieren,Selektinvert,Selektloeschen
  1474.  
  1475. Farben:
  1476.  
  1477.  DATA 0,0,0,1,1,1,1,.2,.2,1,.7,.2,1,1,0,.3,.3,1,.7,.7,1,.5,.5,1          
  1478.  
  1479. Wochentage:
  1480.  
  1481.  DATA "Montag    ","Dienstag  ","Mittwoch  ","Donnerstag"
  1482.  DATA "Freitag   ","Samstag   ","Sonntag   "
  1483.  
  1484. Monatsnamen:
  1485.  
  1486.  DATA "Jänner   ","Februar  ","März     ","April    ","Mai      ","Juni     "
  1487.  DATA "Juli     ","August   ","September","Oktober  ","November ","Dezember "
  1488.  
  1489. Windowclose3:
  1490.  
  1491.  WINDOW CLOSE 3:WINDOW 1
  1492. RETURN
  1493.  
  1494. Datenein:
  1495.  
  1496.  CLOSE #2:diskfehler=0
  1497.  header$=ds$(0)
  1498.  OPEN dateiname$ FOR INPUT AS #2
  1499.  INPUT#2,ds$(0)
  1500.  IF LEFT$(ds$(0),2)="00" THEN Weiter10
  1501.  fehlertext$="Die Datei hat eine falsche Datenstruktur !"
  1502.  diskfehler=4:dateiname$=altdn$:ds$(0)=header$
  1503.  CLOSE #2:GOTO Fehlermeldung
  1504.  
  1505. Weiter10:
  1506.  
  1507.  ERASE m%,show%,show$:DIM m%(7,15),show%(datenmenge),show$(30)
  1508.  GOSUB Systemsetsave
  1509.  dzeitstart$=MID$(ds$(0),4,8):dzeitende$=MID$(ds$(0),13,8)
  1510.  IF zeitstart$<dzeitstart$ OR zeitende$>dzeitende$ THEN
  1511.  zeitstart$=dzeitstart$:zeitende$=dzeitende$
  1512.  END IF
  1513.  d0zeitstart$=dzeitstart$:d0zeitende$=dzeitende$
  1514.  Kontenliste$=RIGHT$(ds$(0),LEN(ds$(0))-21)
  1515.  
  1516. Importein:
  1517.  
  1518.  IF eximfl<>1 THEN anzahl%=0
  1519.  
  1520. Loop12:
  1521.  
  1522.  diskfehler=0
  1523.  IF EOF(2) THEN Loop13 
  1524.  INPUT#2,ds$(anzahl%+1)
  1525.  IF diskfehler>0 THEN
  1526.  fehlertext$="Schadhafte Datenstruktur !"
  1527.  diskfehler=0:eximfl=0:GOTO Fehlermeldung
  1528.  END IF
  1529.  anzahl%=anzahl%+1
  1530.  IF anzahl%>datenmenge-1 THEN CLOSE #2:anzahl%=0:GOTO Datenueberlauf
  1531.  GOTO Loop12 
  1532.  
  1533. Loop13:
  1534.  
  1535.  CLOSE #2 
  1536. RETURN
  1537.  
  1538. Datenueberlauf:
  1539.  
  1540.  IF eximfl=1 THEN anzahl%=altanzahl%
  1541.  fehlertext$="Datei zu groß ! Daten einlesen abgebrochen !"
  1542. GOTO Fehlermeldung
  1543.  
  1544. Rueckschreiben:
  1545.  
  1546.  MOUSE OFF:MENU OFF
  1547.  CLOSE #2
  1548.  diskfehler=0
  1549.  OPEN dateiname$ FOR OUTPUT AS #2
  1550.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Rueckschreiben
  1551.  PRINT #2,ds$(0)
  1552.  x%=1 
  1553.  WHILE x%<=anzahl%
  1554.  IF VAL(RIGHT$(ds$(x%),10))<>0 THEN PRINT #2,ds$(x%)
  1555.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Rueckschreiben
  1556.  x%=x%+1
  1557.  WEND
  1558.  CLOSE #2
  1559. RETURN
  1560.  
  1561. Konteneinlesen:
  1562.  
  1563.  ml%=0:diskfehler=0:CLOSE #2
  1564.  OPEN Kontenliste$ FOR INPUT AS#2
  1565.  INPUT#2,dummy$
  1566.  IF dummy$<>"11" OR diskfehler=2 THEN Kolesefehler
  1567.  ERASE m$,ma%,kontoart$:DIM m$(8,8),ma%(8),kontoart$(8,8)
  1568.  FOR x%=3 TO 7
  1569.  INPUT#2,ma%(x%)
  1570.  FOR y%=0 TO ma%(x%)
  1571.  INPUT#2,m$(x%,y%)
  1572.  INPUT#2,kontoart$(x%,y%)
  1573.  IF m$(x%,y%)<>"" THEN ml%=x%-2
  1574.  NEXT y%,x%
  1575.  CLOSE #2
  1576. RETURN 
  1577.  
  1578.  
  1579. Kolesefehler:
  1580.  
  1581.  CLOSE #2
  1582.  fehlertext$="Kontenliste hat falsches Datenformat !"
  1583. GOTO Fehlermeldung
  1584.  
  1585. Kontensave:
  1586.  
  1587.  operationstext$="Ich speichere nun die Kontenliste !"
  1588.  flag=1:GOSUB Operationsmeldung
  1589.  FOR x%=3 TO 7:FOR y%=0 TO 6
  1590.  IF m$(x%,y%)<>"" THEN ma%(x%)=y%
  1591.  NEXT y%,x%
  1592.  CLOSE #2
  1593.  diskfehler=0
  1594.  OPEN Kontenliste$ FOR OUTPUT AS #2 
  1595.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Kontensave 
  1596.  PRINT#2,"11"
  1597.  FOR x%=3 TO 7
  1598.  PRINT#2,ma%(x%)
  1599.  FOR y%=0 TO ma%(x%)
  1600.  PRINT#2,m$(x%,y%)
  1601.  PRINT#2,kontoart$(x%,y%)
  1602.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Kontensave
  1603.  NEXT y%,x%
  1604.  CLOSE #2
  1605. GOTO Windowclose3
  1606.  
  1607. Systemsetsave:
  1608.  
  1609.  diskfehler=0:CLOSE #3
  1610.  OPEN "Haushaltssystem/Systemset" FOR OUTPUT AS#3
  1611.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Systemsetsave 
  1612.  PRINT #3,dateiname$
  1613.  PRINT #3,Kontenliste$
  1614.  PRINT #3,detailflag%,gesamtflag%,sortflag%
  1615.  PRINT #3,waehrung$
  1616.  PRINT #3,zeitstart$
  1617.  PRINT #3,zeitende$
  1618.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Systemsetsave
  1619.  CLOSE #3
  1620. RETURN
  1621.  
  1622. Systemsetload:
  1623.  
  1624.  CLOSE #2:diskfehler=0
  1625.  OPEN "Haushaltssystem/Systemset" FOR INPUT AS#2
  1626.  IF diskfehler>0 THEN 
  1627.  fehlertext$="Oh weh. Mir fehlt mein SYSTEMSET File !"
  1628.  GOSUB Fehlermeldung:RETURN
  1629.  END IF
  1630.  INPUT #2,dateiname$
  1631.  INPUT #2,Kontenliste$
  1632.  INPUT #2,detailflag%,gesamtflag%,sortflag%
  1633.  INPUT #2,waehrung$
  1634.  INPUT #2,zeitstart$
  1635.  INPUT #2,zeitende$
  1636.  CLOSE #2
  1637. RETURN
  1638.  
  1639. Systemset:
  1640.  
  1641.  datum$=RIGHT$(DATE$,2)+"-"+LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2)
  1642.  zeitstart$="80-01-01"
  1643.  dzeitstart$=zeitstart$
  1644.  zeitende$="99-12-31"
  1645.  dzeitende$=zeitende$
  1646.  d0zeitstart$=zeitstart$
  1647.  d0zeitende$=zeitende$
  1648.  seitendruck=1 
  1649.  waehrung$="ÖS"
  1650.  detailflag%=1
  1651.  sortflag%=1
  1652.  bildzeilen=16
  1653.  dateienmax=20
  1654.  kontenlmax=20
  1655.  dateiname1$="Haushaltsdaten/"
  1656. RETURN
  1657.  
  1658. Import:
  1659.  eximfl=1
  1660.  GOTO Loopvor
  1661.  
  1662. Export:
  1663.  
  1664.  eximfl=0
  1665. Loopvor:
  1666.  IF eximfl=0 THEN WINDOW 3,"Daten exportieren:",(80,50)-(550,140),0,1
  1667.  IF eximfl=1 THEN WINDOW 3,"Daten importieren:",(80,50)-(550,140),0,1
  1668.  PALETTE 3,0,0,0
  1669.  LOCATE 5,16:PRINT "Bitte Dateinamen eingeben !"            
  1670.  LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b
  1671.  PAINT (55,51),3
  1672.  PALETTE 3,r(3),g(3),b(3)
  1673.  LOCATE 8,10:laenge=39:msgs$=dateiname1$:GOSUB Superinput:dateiname1$=msgs$
  1674.  diskfehler=0
  1675.  OPEN dateiname1$ FOR INPUT AS #2
  1676.  CLOSE #2
  1677.  IF diskfehler=0 THEN Dateivorhanden   
  1678.  IF eximfl=1 THEN 
  1679.   fehlertext$="Datei nicht vorhanden"
  1680.   GOTO Fehlermeldung
  1681.  END IF
  1682.  WINDOW 3,"Dateien Exportieren:",(80,50)-(550,140),0,1
  1683.  LOCATE 4,15:PRINT " Dateiname für Export frei."
  1684.  LOCATE 6,15:PRINT "Wollen Sie nun exportieren ?"
  1685.  fehler=3
  1686.  ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
  1687.  mousep%=10:RETURN
  1688. Mp10: 
  1689.  mousep%=0 
  1690.  IF fehler=1 THEN Windowclose3
  1691. GOTO Exportieren
  1692.           
  1693. Dateivorhanden:
  1694.  IF eximfl=0 THEN 
  1695.  WINDOW 3,"Daten exportieren:",(80,50)-(550,140),0,1
  1696.  LOCATE 4,12:PRINT "      Dateiname schon vorhanden."
  1697.  LOCATE 6,12:PRINT "Wollen Sie diese Datei überschreiben ?"
  1698.  END IF
  1699.  IF eximfl=1 THEN
  1700.  WINDOW 3,"Daten Importieren:",(80,50)-(550,140),0,1
  1701.  LOCATE 4,12:PRINT  "          Dateiname vorhanden."
  1702.  LOCATE 6,12:PRINT  "  Wollen Sie diese Datei importieren ?"
  1703.  END IF
  1704.  fehler=3
  1705.  ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
  1706.  mousep%=11:RETURN
  1707. Mp11:
  1708.  mousep%=0  
  1709.  IF fehler=1 THEN GOTO Windowclose3
  1710.  IF eximfl=0 THEN Exportieren
  1711.  
  1712. Importieren:
  1713.  
  1714.  diskfehler=0
  1715.  OPEN dateiname1$ FOR INPUT AS #2
  1716.  IF diskfehler>0 THEN CLOSE #2:GOTO Fehlermeldung
  1717.  INPUT#2,dummy$
  1718.  IF LEFT$(dummy$,2)<>"22" THEN
  1719.  fehlertext$="Datenformat falsch !!!!"
  1720.  CLOSE #2:GOTO Fehlermeldung
  1721.  END IF
  1722.  IF dummy$<>"22 "+Kontenliste$ THEN
  1723.  WINDOW 3,"Warnung:",(80,50)-(550,140),0,1
  1724.  LOCATE 4,15:PRINT "   Kontenlisten nicht gleich."
  1725.  LOCATE 6,15:PRINT "Wollen Sie trotzdem importieren ?"
  1726.  ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
  1727.  mousep%=12:RETURN
  1728. Mp12:
  1729.  mousep%=0  
  1730.  IF fehler=1 THEN CLOSE#2:GOTO Windowclose3
  1731.  END IF
  1732.  
  1733.  CLS
  1734.  LOCATE 4,14:PRINT "    Sollen die Importierten Daten"
  1735.  LOCATE 6,14:PRINT "  in die Datei eingebunden werden ?"
  1736.  ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:mskip=0:GOSUB Bestaetigung
  1737.  mousep%=15:RETURN
  1738. Mp15:
  1739.  mousep%=0  
  1740.  IF fehler=0 THEN fiximp%=1:ELSE:fiximp%=0
  1741.  altanzahl%=anzahl%
  1742.  GOSUB Importein:eximfl=0
  1743.  IF fiximp%=1 THEN GOSUB Rueckschreiben
  1744. GOTO Windowclose3 
  1745.  
  1746. Exportieren:
  1747.  
  1748.  IF z%<1 THEN 
  1749.  fehlertext$="Keine Daten zum Exportieren vorhanden !"
  1750.  GOTO Fehlermeldung
  1751.  END IF
  1752.  IF LEFT$(show$(1),2)="00" THEN
  1753.  fehlertext$="Monatsabrechnungen können nicht exportiert werden!"
  1754.  GOTO Fehlermeldung
  1755.  END IF 
  1756.  diskfehler=0
  1757.  OPEN dateiname1$ FOR OUTPUT AS #2
  1758.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Exportieren
  1759.  IF diskfehler>0 THEN
  1760.  CLOSE #2:GOTO Fehlermeldung
  1761.  END IF
  1762.  PRINT#2,"22 "Kontenliste$
  1763.  FOR x%=1 TO z%
  1764.  IF gesamtakt%=1 THEN
  1765.  PRINT#2,show$(x%)
  1766.  ELSE
  1767.  PRINT#2,ds$(show%(x%))
  1768.  END IF
  1769.  IF diskfehler=4 THEN GOSUB Fehlermeldung:GOTO Exportieren
  1770.  NEXT x%
  1771.  CLOSE #2
  1772. GOTO Windowclose3           
  1773.  
  1774. Konten:
  1775.  
  1776.  MENU OFF:MOUSE OFF
  1777.  WINDOW 3,"Kontenlisten aktuallisieren:",(80,50)-(550,140),0,1
  1778.  PALETTE 3,0,0,0
  1779.  LOCATE 5,14:PRINT "Bitte Kontenlistenname eingeben !"            
  1780.  LINE (54,50)-(408,68),3,b:LINE (69,54)-(393,64),3,b
  1781.  PAINT (55,51),3
  1782.  PALETTE 3,r(3),g(3),b(3)
  1783.  alkoli$=Kontenliste$
  1784.  IF Kontenliste$="" THEN Kontenliste$="Haushaltskonten/"
  1785.  LOCATE 8,10:laenge=39:msgs$=Kontenliste$:GOSUB Superinput
  1786.  Kontenliste$=msgs$
  1787.  diskfehler=0
  1788.  OPEN Kontenliste$ FOR INPUT AS #2
  1789.  CLOSE #2
  1790.  IF diskfehler=0 THEN GOSUB Konteneinlesen:GOTO Kontenmaske  
  1791.  WINDOW 3,"Kontenlisten Aktuallisieren:",(80,50)-(550,140),0,1
  1792.  LOCATE 4,9:PRINT "Ich habe diese Kontenliste nicht gefunden !"
  1793.  LOCATE 6,9:PRINT "Wollen Sie diese Kontenliste neu erstellen ?"
  1794.  fehler=3
  1795.  ttextrl=9:ttextrp=20:ttextfl=9:ttextfp=34:GOSUB Bestaetigung
  1796.  mousep%=13:RETURN
  1797. Mp13:
  1798.  mousep%=0  
  1799.  IF fehler=1 THEN Kontenliste$=alkoli$:GOTO Windowclose3
  1800.  ERASE m$,ma%,kontoart$:DIM m$(8,6),ma%(8),kontoart$(8,6)
  1801.  
  1802. Kontenmaske:
  1803.  
  1804.  GOSUB Windowclose3
  1805.  kontenaktiv%=1
  1806.  MOUSE ON :MENU OFF
  1807.  GOSUB Bildaus
  1808.  CLS
  1809.  LINE(15,5)-(625,17),2,b 
  1810.  LOCATE 2,5:PRINT"Kontenliste :"
  1811.  LOCATE 2,19:PRINT Kontenliste$
  1812.  LINE(15,37)-(625,115),3,bf:LINE(15,21)-(625,35),3,bf
  1813.  FOR x%=0 TO 4 
  1814.  LOCATE 4,x%*15+4:PRINT SPACE$(9)
  1815.  LOCATE 4,x%*15+4:PRINT m$(x%+3,0)
  1816.  NEXT 
  1817.  FOR x%=0 TO 4:FOR y%=1 TO 5
  1818.  LOCATE y%*2+4,x%*15+4:PRINT SPACE$(10)
  1819.  LOCATE y%*2+4,x%*15+4:PRINT m$(x%+3,y%+1)
  1820.  LOCATE y%*2+4,x%*15+15:PRINT SPACE$(3)
  1821.  LOCATE y%*2+4,x%*15+15:PRINT kontoart$(x%+3,y%+1)
  1822.  NEXT y%,x%
  1823.  FOR x%=1 TO 4
  1824.  LINE(120*x%+19,21)-(120*x%+20,115),0,b
  1825.  LINE(15,x%*16+36)-(625,x%*16+36),0,b
  1826.  NEXT
  1827.  ttextrl=18:ttextrp=28:ttextfl=18:ttextfp=45:GOSUB Bestaetigung
  1828.  GOSUB Bildein
  1829. RETURN
  1830.  
  1831. Kontenmousecheck:
  1832.  
  1833.  IF MOUSE(2)>115 THEN GOSUB Mouseposition:GOTO Kontentasten
  1834.  IF MOUSE(1)<=20 OR MOUSE(1)>=625 THEN RETURN
  1835.  IF MOUSE(2)<=20 THEN RETURN
  1836.  xwert%=INT((MOUSE(1)-20)/120)
  1837.  ywert%=INT((MOUSE(2)-20)/16)
  1838.  MOUSE OFF
  1839.  IF ywert%=0 THEN
  1840.  LOCATE ywert%*2+4,xwert%*15+4:msgs$=m$(xwert%+3,ywert%):laenge=8
  1841.  GOSUB Superinput:m$(xwert%+3,ywert%)=msgs$:m$(xwert%+3,ywert%+1)=msgs$
  1842.  MOUSE ON:RETURN
  1843.  END IF
  1844.  
  1845.  LOCATE ywert%*2+4,xwert%*15+4:msgs$=m$(xwert%+3,ywert%+1):laenge=9
  1846.  GOSUB Superinput:m$(xwert%+3,ywert%+1)=msgs$
  1847. Kontenart:
  1848.  LOCATE ywert%*2+4,xwert%*15+15:msgs$=kontoart$(xwert%+3,ywert%+1):laenge=2
  1849.  GOSUB Superinput:kontoart$(xwert%+3,ywert%+1)=msgs$
  1850.  IF msgs$="+" OR msgs$="-" OR msgs$="-u" OR msgs$="+u" THEN Weiter11
  1851.  kontoart$(xwert%+3,ywert%+1)="+":GOTO Kontenart
  1852. Weiter11: 
  1853.  MOUSE ON
  1854. RETURN
  1855.  
  1856. Kontentasten:
  1857.  
  1858.  IF fehler=3 THEN RETURN
  1859.  IF fehler=0 THEN GOSUB Kontensave
  1860.  IF fehler=1 THEN Kontenliste$=alkoli$
  1861.  operationstext$="Ich Aktuallisiere die Kontenliste !"
  1862.  flag=1:GOSUB Operationsmeldung
  1863.  GOSUB Konteneinlesen
  1864.  GOSUB Machkonten
  1865.  kontenaktiv%=0
  1866.  tabaktiv=0
  1867.  GOSUB Windowclose3
  1868.  GOSUB Tabmaske
  1869. GOTO Tabausgabe
  1870.  
  1871. Openwindow3:
  1872.  
  1873.  MENU OFF:MOUSE OFF
  1874.  WINDOW 3,windowtext$,(80,50)-(550,140),0,1
  1875. RETURN 
  1876.  
  1877.  
  1878. Autor:
  1879.  
  1880.  windowtext$="Der Autor !!!!!!!!!!! ":GOSUB Openwindow3
  1881.  CLS
  1882.  LOCATE 2,25:PRINT"Sauer Franz"
  1883.  LOCATE 3,20:PRINT"Senefeldergasse 58/28"
  1884.  LOCATE 4,25:PRINT"A-1100 Wien"
  1885.  LOCATE 5,13:PRINT"Tel. (Österreich) 0222 / 62 68 383"
  1886.  LOCATE 7,7: PRINT"Sollten noch Fragen zum Programm auftreten so"
  1887.  LOCATE 8,7: PRINT"richten Sie sich bitte an die oben angegebene"
  1888.  LOCATE 9,7: PRINT"Adresse. Ich bin gerne bereit zu helfen. Ich "
  1889.  LOCATE 10,7:PRINT"hoffe Sie können mein Programm nutzen."
  1890.  fakt%=1
  1891. RETURN 
  1892.  
  1893. Hilfe:
  1894.  
  1895.  MOUSE OFF
  1896.  WINDOW 3,"Hilfe !!!!!!!",(80,50)-(550,140),0,1
  1897.  LOCATE 2,25:PRINT "Hilferoutine"
  1898.  LOCATE 4,7:PRINT " Durch Anwählen eines Menüpunktes erhalten Sie"
  1899.  LOCATE 5,7:PRINT "eine Ausführliche  Beschreibung der jeweiligen"
  1900.  LOCATE 6,7:PRINT "Funktion. Durch Drücken einer beliebigen Taste"
  1901.  LOCATE 7,7:PRINT "blättern Sie nach vor.Durch 'Mouseclick' unter-"
  1902.  LOCATE 8,7:PRINT "brechen Sie die Hilferoutine und kehren wieder"
  1903.  LOCATE 9,7:PRINT "ins Hauptprogramm zurück. Wählen Sie nun bitte"
  1904.  LOCATE 10,7:PRINT"einen Menüpunkt.
  1905.  hilfeflag%=1
  1906. RETURN
  1907.  
  1908. Hilferoutine:
  1909.  
  1910.  WHILE INKEY$<>"":WEND
  1911.  hilfeflag%=0
  1912.  IF leiste>2 THEN punkte=0:leiste=1
  1913.  IF punkte>14 OR hilfefile$(leiste-1,punkte)="" THEN 
  1914.  fehlertext$="Dafür gibt es keinen Hilfetext !"
  1915.  GOTO Fehlermeldung
  1916.  END IF
  1917.  diskfehler=0:CLOSE #2
  1918.  OPEN "Hilfe/"+hilfefile$(leiste-1,punkte) FOR INPUT AS#2
  1919.  IF diskfehler=0 THEN Hilfeladen
  1920.  fehlertext$="Sorry, mir hat jemand das Hilfefile gestohlen !"
  1921.  CLOSE #2
  1922. GOTO Fehlermeldung
  1923.  
  1924. Hilfeladen:
  1925.  
  1926.  WINDOW 3,"Beschreibung für "+hilfefile$(leiste-1,punkte),(80,50)-(550,140),0,1
  1927.  hzeile%=1:hlf%=1
  1928. Weiter13:
  1929.  IF EOF(2) THEN Weiter14
  1930.  LINE INPUT#2,zeighilfe$
  1931.  IF hzeile%>9 THEN 
  1932.  mousep%=16
  1933. RETURN 
  1934.  
  1935. Mp16:
  1936.  mousep%=0 
  1937.  hzeile%=1:CLS
  1938.  IF tdr=0 THEN Weiter15
  1939.  END IF
  1940.  hzeile%=hzeile%+1:hlaenge%=LEN(zeighilfe$)*8
  1941.  LOCATE hzeile%,1
  1942.  IF zeighilfe$<>"" THEN PRINT PTAB(240-hlaenge%/2)zeighilfe$
  1943.  tdr=0:GOTO Weiter13
  1944. Weiter14:
  1945.  mousep%=17
  1946. RETURN
  1947. Mp17:
  1948.  mousep%=0 
  1949. Weiter15:
  1950.  hlf%=0:CLOSE #2
  1951. GOTO Windowclose3
  1952.  
  1953. Sysst:
  1954.  
  1955.  windowtext$="Systemstatus:":GOSUB Openwindow3
  1956.  LOCATE 2,2:PRINT "Aktuelle Datei       :"dateiname$
  1957.  LOCATE 3,2:PRINT "Aktuelle Kontenliste :"Kontenliste$
  1958.  LOCATE 4,2:PRINT "Zeitbereich der Datei:"d0zeitstart$" bis "d0zeitende$
  1959.  LOCATE 5,2:PRINT "Aktuelle Zeitmaske   :"zeitstart$" bis "zeitende$
  1960.  LOCATE 6,2:PRINT "--------------------------------------------------------"
  1961.  LOCATE 7,2:PRINT "Dateigröße :"datenmenge"    Verbraucht:"anzahl%"    Frei:"datenmenge-anzahl%
  1962.  LOCATE 8,2:PRINT "--------------------------------------------------------"
  1963.  LOCATE 9,2:PRINT "Freie Bytes im Systemspeicher  :"FRE(-1)
  1964.  LOCATE 10,2:PRINT "Freie Bytes für Haushaltsdaten :"FRE(0)
  1965.  fakt%=1
  1966. RETURN
  1967.  
  1968. Wae:
  1969.  
  1970.  WINDOW 3,"Währungszeichen ändern:",(180,60)-(450,140),0,1
  1971.  LOCATE 2,2:PRINT "Bitte Währungszeichen eingeben."
  1972.  LINE (90,29)-(180,42),3,bf
  1973.  LOCATE 5,16:PRINT SPACE$(3):msgs$=waehrung$:laenge=2
  1974.  LOCATE 5,16:GOSUB Superinput:waehrung$=msgs$
  1975.  ttextrl=8:ttextrp=9:ttextfl=8:ttextfp=22:GOSUB Bestaetigung
  1976.  mousep%=14:RETURN
  1977. Mp14:
  1978.  mousep%=0 
  1979.  IF fehler=1 THEN Windowclose3
  1980.  WINDOW 1:LOCATE 21,58:PRINT "Gesamt   "
  1981.  LOCATE 21,65:PRINT waehrung$
  1982.  GOSUB Systemsetsave
  1983. GOTO Windowclose3
  1984.  
  1985. Cursor:   
  1986.  
  1987.  LINE (0,0)-(7,7),2,bf
  1988.  GET (0,0)-(7,7),c%
  1989.  GET (0,0)-(1,7),cs%
  1990.  LINE (0,0)-(7,7),0,bf
  1991. RETURN 
  1992.  
  1993. Openlibrarys:
  1994.  
  1995.  diskfehler=0
  1996.  LIBRARY "graphics.library"
  1997.  IF diskfehler>0 THEN
  1998.  fehlertext$="Graphics Library nicht vorhanden !"
  1999.  GOSUB Fehlermeldung:SYSTEM
  2000.  END IF
  2001.  LIBRARY "exec.library"
  2002.  IF diskfehler>0 THEN
  2003.  fehlertext$="Exec Library nicht vorhanden !"
  2004.  GOSUB Fehlermeldung:SYSTEM
  2005.  END IF
  2006.  LIBRARY "intuition.library"
  2007.  IF diskfehler>0 THEN 
  2008.  fehlertext$="Intuition Library nicht vorhanden !"
  2009.  GOSUB Fehlermeldung:SYSTEM
  2010.  END IF
  2011. RETURN                
  2012.                 
  2013. Mcp:
  2014.  
  2015.  dummy=MOUSE(0):xpos%=MOUSE(3):ypos%=MOUSE(4)
  2016.  IF xpos%>(offset%)*8 AND xpos%<(offset%+laenge)*8 THEN
  2017.    IF ypos%>(y%-1)*8-3 AND ypos%<y%*8+3 THEN
  2018.      mcpos%=INT((xpos%)/8)-offset%
  2019.   END IF
  2020.  END IF
  2021. RETURN
  2022.  
  2023. Editor:
  2024.  
  2025.  ed%=1:
  2026.  MOUSE ON
  2027.  mcpos%=-1
  2028.  max%=laenge
  2029.  backup$=msgs$
  2030.  y%=CSRLIN
  2031.  offset%=POS(0)-1
  2032.  mode%=1:bu%=0
  2033.  x%=LEN(backup$):in$=""
  2034.  ox%=LEN(prompt$)+1
  2035.  IF type%=0 THEN
  2036.  lo=32:hi=255:r1=lo:r2=hi
  2037.  ELSEIF type%=1 THEN
  2038.  lo=45:hi=57:r1=40:r2=43
  2039.  END IF
  2040.             
  2041.  LOCATE y%,1+offset%
  2042.  PRINT  prompt$;backup$
  2043.  y%=CSRLIN-1
  2044.  GOSUB Putc        
  2045.  WHILE in$<>CHR$(13)
  2046.  in$=""
  2047. Loop25:
  2048.  SLEEP
  2049.  in$=INKEY$
  2050.  IF in$<>"" OR mcpos%>=0 THEN Loop26
  2051.  GOTO Loop25
  2052. Loop26:
  2053.  IF mcpos%<0 THEN 
  2054.  bx%=x%
  2055.  IF in$=CHR$(8) THEN '[BACKSPACE]
  2056.  in$=""
  2057.  wipe%=1
  2058.  IF x%>0 THEN x%=x%-1
  2059.  ELSEIF in$=CHR$(127) THEN '[DEL]
  2060.  in$=""
  2061.  wipe%=1
  2062.  END IF
  2063.  IF (in$>=CHR$(lo) AND in$<=CHR$(hi)) OR (in$>=CHR$(r1)AND in$<=CHR$(r2)) OR in$="" THEN
  2064.  add$=LEFT$(backup$,x%)+in$
  2065.  IF x%=LEN(backup$) THEN
  2066.    backup$=add$
  2067.    ELSEIF x%>LEN(backup$) THEN
  2068.    diff%=x%-LEN(backup$)
  2069.    backup$=backup$+SPACE$(diff%)+in$
  2070.   ELSE
  2071.    backup$=add$+RIGHT$(backup$,LEN(backup$)-x%-mode%)
  2072.  END IF
  2073.  IF wipe%=1 THEN
  2074.    wipe%=0
  2075.   ELSE
  2076.    x%=x%+1
  2077.  END IF
  2078.  ELSEIF in$=CHR$(27) THEN '[INSERT]
  2079.  SWAP mode%,bu%
  2080.  ELSEIF in$=CHR$(31) THEN '[CSRLEFT]
  2081.  IF x%>0 THEN
  2082.   x%=x%-1
  2083.   ELSE
  2084.   BEEP
  2085.   END IF
  2086.   ELSEIF in$=CHR$(30) THEN '[CSRRIGHT]
  2087.   x%=x%+1
  2088.   END IF
  2089.  IF bu%=0 THEN
  2090.  PUT ((bx%+LEN(prompt$)+offset%)*8,(y%-1)*8),c%,XOR
  2091.  ELSE
  2092.  PUT ((bx%+LEN(prompt$)+offset%)*8,(y%-1)*8),cs%,XOR
  2093.  END IF
  2094.  IF type%=3 THEN
  2095.    IF x%>0 THEN x%=x%-1
  2096.    ELSEIF x%>max% THEN
  2097.     x%=x%-1
  2098.     BEEP
  2099.    END IF
  2100.    IF LEN(backup$)>max% THEN
  2101.     backup$=LEFT$(backup$,max%)
  2102.     BEEP
  2103.  END IF 
  2104.  LOCATE y%,ox%+offset%
  2105.  bu$=backup$+SPACE$(1)
  2106.  CALL Text(WINDOW(8),SADD(bu$),LEN(bu$))
  2107.  GOSUB Putc
  2108.  ELSE
  2109.  GOSUB Putc
  2110.  x%=mcpos%:mcpos%=-1
  2111.  GOSUB Putc
  2112.  END IF
  2113.  MOUSE ON
  2114.  WEND            
  2115.  GOSUB Putc
  2116.  msgs$=backup$ 
  2117.  ed%=0
  2118. RETURN
  2119.  
  2120. Putc:
  2121.  
  2122.  IF bu%=0 THEN
  2123.  PUT ((x%+LEN(prompt$)+offset%)*8,(y%-1)*8),c%,XOR
  2124.  ELSE
  2125.  PUT ((x%+LEN(prompt$)+offset%)*8,(y%-1)*8),cs%,XOR
  2126.  END IF
  2127. RETURN 
  2128.  
  2129. RETURN 
  2130.  
  2131. Guru:
  2132.  
  2133.  alertnum&=0
  2134.  res&=DisplayAlert&(alertnum&,SADD(errText1$),56)
  2135. GOTO Ende
  2136.  
  2137. Outoffmemtext:
  2138.  
  2139.  errText1$=CHR$(0)+CHR$(96)+CHR$(20)+"Oh weh, oh weh, da ist ein schwerer Fehler aufgetreten !"
  2140.  errText1$=errText1$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(72)+CHR$(30)+"Ich sehe mich daher leider gezwungen das Programm zu Beenden."                      
  2141.  errText1$=errText1$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(168)+CHR$(40)+"Drücken Sie nun die linke Maustaste."
  2142.  
  2143.  errText$=CHR$(0)+CHR$(96)+CHR$(20)+"Jetzt  haben Sie es geschafft .  Mir ist  der Speicher"
  2144.  errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(28)+"ausgegangen. Versuchen Sie eventuell geöffnete Fenster"
  2145.  errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(36)+"zu schließen  oder Programme die noch Speicher belegen"
  2146.  errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(44)+"wegzuräumen . Sollte ich wieder mehr als  30000  Bytes"
  2147.  errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(52)+"freien Systemspeicher vorfinden so können Sie mit viel"
  2148.  errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(96)+CHR$(60)+"Glück ihre Arbeit fortsetzen."
  2149.  errText$=errText$+CHR$(0)+CHR$(1)+CHR$(0)+CHR$(168)+CHR$(82)+"Drücken Sie nun die Linke Maustaste."
  2150.  errText$=errText$+CHR$(0)
  2151. RETURN
  2152.  
  2153. Outoffmem:
  2154.  
  2155.  alertnum&=0
  2156.  res&=DisplayAlert&(alertnum&,SADD(errText$),100)
  2157.  GOSUB Mouseclick
  2158.  IF ERR=7 THEN RUN
  2159. RETURN
  2160.  
  2161. Screendown:
  2162.  
  2163.  FOR x%=1 TO 28
  2164.  sc&=PEEKL(WINDOW(7)+46)
  2165.  CALL MoveScreen(sc&,0,10)
  2166.  NEXT
  2167. RETURN
  2168.  
  2169. Screenup:
  2170.  
  2171.  FOR x%=1 TO 28
  2172.  sc&=PEEKL(WINDOW(7)+46)
  2173.  CALL MoveScreen(sc&,0,-10)
  2174.  NEXT
  2175. RETURN
  2176.  
  2177. Declarieren:
  2178.  
  2179.  IF alreadydeclared = 0 THEN
  2180.   DECLARE FUNCTION DisplayAlert&  LIBRARY
  2181.   DECLARE FUNCTION AllocSignal%() LIBRARY
  2182.   DECLARE FUNCTION AllocMem&()    LIBRARY
  2183.   DECLARE FUNCTION FindTask&()    LIBRARY
  2184.   DECLARE FUNCTION DoIO&()        LIBRARY
  2185.   DECLARE FUNCTION OpenDevice&    LIBRARY
  2186.   alreadydeclared = 1
  2187.  END IF
  2188. RETURN
  2189.  
  2190.  
  2191.  
  2192.  
  2193.  
  2194.  
  2195.  
  2196.  
  2197.